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ABSTRACT 


‘  ^"The  CORDIVEM  combat  simulation  model  requires  large  amounts  of  terrain 
data  for  successful  modelling  of  corps  and  division  level  processes.  As  of 
March  1982  the  terrain  data  was  limited  to  the  usual  Fulda  Gap  area  of  the 
Federal  Republic  of  Germany  (FRG).  This  document  describes  the  data  sources 
and  the  methods  used  to  develop  a  corps-sized  European  terrain  data  base  for 
the  Corps  -  Division  Evaluation  Model.  - 
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MAIN  REPORT 
1 .  Background . 

a.  CORDIVEM  requirements. 

(1)  Operational  data.  When  purchased  from  BOM,  the  model  ran  -  and 
still  runs  -  on  hexagonal  cells  (hexes)  of  terrain  data.  The  format  of  this 
hex  data  has  not  been  changed  from  that  of  1C0R.  Each  hex  has  a  3.57  km  inner 
diameter  and  contains  stylized  information  on  terrain  roughness,  cover  and 

1 ines-of-communication  (LOC,  roads)  and  hydrography  (rivers).  (See  appendix 
A.)  This  original  hex  data  covers  a  roucfily  oval-shaped  area  centered  near 
Fulda  with  a  radius  of  50  to  120  km.  BDM  Services  Corporation  (the  developer 
of  I  COR )  produced  this  hex  data  by  a  visual  analysis  of  1:50,000  scale  maps. 

(2)  Display  data.  Part  of  the  evolution  of  CORDIVEM  from  ICOR  has 
been  the  grafting  of  display  data  and  software  from  the  Corps  Battle  Game 
(CGB)  effort  onto  the  model.  The  display  data  currently  being  used  for 
demonstration  is  the  result  of  patdiing  and  reformatting  of  some  special 
high-resolution  digital  products  prepared  by  the  Defense  Mapping  Agency 
(DMA).  The  file  represents  an  area  extending  200  km  in  the  east-west  axis  and 
150  km  in  the  north-south  axis  centered  at  32UPB00.  In  the  display  file  the 
data  is  at  100m  resolution  with  each  point  having  a  surface  feature  code 
(open,  forest,  urban)  and  an  elevation  value.  In  addition  to  this  areal  data 
there  is  a  small  network  of  roads  and  rivers  which  was  digitized  by  CASAA 
personnel  (now  part  of  CAORA)  using  software  delivered  to  BDM  for  use  in  their 
LOC /terrain  analysis  effort. 

b.  LOC/Terrain  database. 

(1)  Background: 

(a)  Oata  sources.  In  December  of  1979  CASAA  (now  part  of  CAORA) 
issued  a  contract  to  BDM  Services  Corporation  to  produce  a  terrain  data  base 
for  the  Corps  Battle  Game,  a  predecessor  of  CORDIVEM.  Linder  the  terms  of  this 
contract  BDM  was  to  produce  digitized  terrain  data,  loc  and  hydrography  nets 
for  virtually  all  of  Germany.  The  form  of  this  data  was  to  match  the 
previously-mentioned  display  data.  It  was  to  be  developed  using  DMA  elevation 
data,  using  CASAA-suppl ied  maps,  software  and  hardware,  and  the  "Bundespost" 
data. 


(b)  Bundespost  data.  The  Bundespost  data  was  produced  by  the 
post  office  (Bundespost)  of  the  Federal  Republic  of  Germany.  It  was  provided 
to  Electromagnetic  Compatibil ity  Analysis  Center  (ECAC)  in  1976.  ECAC 
reformatted  this  data  and  forwarded  a  copy  to  TRASANA  in  1979.  This  data 
contained  100m  surface  feature  codes  and  elevation  data  for  all  of  FRG  and  was 
the  only  large-scale  terrain  database  available  for  Germany.  Unfortunately, 
the  data  contained  many  inconsistencies. 
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(2)  Areal.  As  part  of  BDM's  LOC /Terrain  contract  the  Bundespost  data 
was  obtained  from  TRASANA.  This  data  was  used  to  represent  FR6  while  DMA 
elevation  data  was  used  for  German  Democratic  Republic  (East  Germany)  with  no 
surface  feature  data. 

(3)  Linear.  The  principal  effort  was  an  analysis  and  digitization  of 
the  loc  and  hydrography  network  for  virtually  all  of  Germany  -  an  area 
represented  by  about  600  1:50,000  scale  maps. 

(4)  Final  product.  The  final  result  of  this  effort  was  a  database 
extending  roughly  400  km  east-to-west  and  600  km  north-to-south  to  be  used  as 
the  terrain  database  for  the  CBG.  The  shortcomings  of  the  areal  data  were 
recognized  and  it  was  originally  intended  to  serve  as  an  interim  resource. 
Nevertheless,  this  is  the  source  used  in  our  production  of  operational  and 
display  data  for  CORDIVEM. 

2.  Method. 

a.  Preprocessing. 

(1)  Inspection.  After  reinspecting  the  areal  data  it  was  determined, 
since  CORDIVEM  operates  on  the  3.57  km  hex  cell,  that  the  elevation  data  was 
accurate  enough  for  CORDIVEM  hex  data  use  and  that  the  surface  data  could  be 
graphically  emended. 

(2)  Editing.  The  objective  of  editing  the  feature  data  was  to  ensure 
that  the  areas  of  urban  and  forest  code  were  in  approximately  the  right 
location  and  size  for  incorporation  into  the  hexes;  no  other  factors  were 
considered.  The  editing  was  accomplished  by  displaying  a  20-  or  40-km  square 
(operator's  choice)  on  a  Tektronix  4027  terminal,  comparing  the  display  to  a 
1:50,000  scale  map  and  making  changes  to  the  data  with  a  "rectangular 
cookie-cutter"  routine. 

(3)  Digitization.  To  fill  part  of  the  GDR  void  in  the  data  base,  the 
urban  and  forested  areas  from  74  1:50,000  scale  maps  were  digitized  on  a 
Tektronix  4081  system.  This  data  was  then  transferred  to  the  VAX,  reformatted 
and  packed  into  the  terrain  data  files.  This  data  was  then  edited  in  the  same 
fashion  as  the  Bundespost  data. 

(4)  Additions.  The  only  change  to  the  linear  data  was  to  insert 
end-nodes  into  the  link  records.  (A  link  is  a  section  of  road  or  river  and  a 
node  is  an  end  point  of  this  section;  the  original  links  only  contained  a 
start  node  with  no  stop.) 

b.  Areal  data  aggregation.  Each  hex  within  the  area  was  approximated  by 
a  circle  with  a  radius  of  2,000m  (the  3.57  km  hex  has  an  inner  radius  of  1785m 
on  an  outer  radius  of  2061m).  Tallies  were  then  made  of  the  surface  feature 
codes  of  the  data  points  within  this  circle,  and  average  elevation  and  average 
absolute  slope  were  then  calculated.  The  hex  address,  UTM  coordinates, 
average  elevation,  percent  slope  and  percent  open,  urban  and  forest  cover  were 
written  to  a  file  for  further  processing. 
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c.  Linear  data  aggregation. 

(1)  LOC-hydrography  differences.  While  the  loc  and  hydrography  nets 
are  similar,  they  differ  in  function.  The  same  is  true  of  their  more  abstract 
representation  in  the  hex  data:  the  loc  provides,  and  the  hydrography  impedes 
access  from  one  area  to  another.  Thus,  slightly  different  algorithms  were 
used  for  aggregating  each  type  of  data  into  the  hex  format. 

(2)  LOC.  The  road  net  was  processed  by  link  records.  If  the 
terminal  nodes  of  a  link  were  in  adjacent  hexes,  then  this  connectivity  was 
recorded  in  the  common  side  of  both  hexes  and  the  next  link  was  accessed.  If 
not,  then  the  first  subnode  (essentially  a  subnode  is  a  curve  in  the  link)  was 
accessed.  If  the  initial  node  and  this  subnode  were  in  adjacent  hexes,  then 
this  was  recorded  as  a  hex  connectivity;  the  subnode  was  then  regarded  as  the 
initial  node  whether  in  the  same  or  adjacent  hex  and  the  process  iterated  to 
completion.  (The  case  where  the  subnode  was  in  a  nonadjacent  hex  indicated  an 
error  in  the  source  data.) 

(3)  Hydrography.  In  converting  the  hydrography  to  hex  data,  each 
link  was  inspected  subnode-by-subnode  so  that  it  could  be  approximated  by  hex 
sides. 

(4)  Postprocessing.  In  both  cases  the  source  network  and  the 
resulting  hex  data  were  graphically  displayed  on  a  Tektronix  4027  terminal  for 
.interactive  correction.  A  subjective  judgment  is  that  less  than  5  percent  of 
the  hex  data  was  changed,  so  that  even  without  editing  the  data  would  probably 
have  been  acceptable. 

3.  Results. 

a.  Extent.  The  area  represented  by  the  resulting  data  base  is 

appt  ..imately  square,  it  is  centered  at  32UNC00  and  extends  400  km  along  each 
axis. 

b.  Format. 


(1)  Hex.  The  hex  data  is  in  a  file  indexed  by  hex  address  and  UTM 
coordinates  of  the  hex  center;  a  user  can  extract  a  desired  rectangular 
portion  in  the  CORDIVEM  input  format  by'running  the  provided  routine  ‘HEXOUT. 1 

(2)  Display.  Each  10  km  square  of  areal  data  is  stored  in  a  file 
indexed  by  the  UTM  coordinate  of  its  southwest  corner  (i.e.,  32UNC45).  The 
linear  data  is  as  provided  by  BDM  except  that  the  end  node  coordinates  have 
been  substituted  for  the  seldom-used  route  numbers  (the  original  data  is  still 
available) . 


APPENDIX  A.  Data  Structure  and  Access  Methods 

1.  Hex  Data. 

a.  Location.  The  hex  data  is  stored  in  the  file  HEXTERR.DAT  in  the 
save-set  Hf;X. BCK  on  tape  #817  in  the  CGF  tape  library. 

b.  Fi  le  structure.  HEXTERR.DAT  is  an  indexed  sequential  file.  The 
primary  index  being  the  hex  address  with  two  secondary  indices  -  the  UTM 
coordinates  of  the  hex  center. 

c.  Record  structure.  Each  record  contains  7  1*4  words  as  follows:  hex 
address,  easting  and  northing  of  the  hexcenter  (UTM),  average  elevation, 
connectivity  codes,  river  codes  and  surface  feature  codes.  The  hex  address  is 
the  external  form;  the  easting,  the  northing  and  the  average  elevation  are  in 
meters;  the  connectivity  and  river  codes  are  packed  in  descending  order  of 
sides  (i.e.,  from  side  6  to  side  1);  and  the  surface  feature  codes  are  packed 
in  the  order:  urbanization,  forestation,  roughness. 

d .  Access  methods. 

(1)  A  CORDIVEM  input  file  for  a  selected  rectangular  area  can  be 
obtained  by  running  the  routine  HEXDUT,  which  is  also  in  HEX. BCK. 

(2)  To  access  the  file  HEXTERR.DAT  from  a  user-written  routine,  the 
file  should  be  opened  with: 

STATUS  *  '0L0' 

ORG  *  'INDEXED' 

ACCESS  =  'KEYED' 

RECL  *  7 

RECORDTYPE  =  'FIXED' 

FORM  =  'UNFORMATTED' 

KEY  =  ( 1 :4: INTEGER,  5 :8:INTEGER,9 : 12 : INTEGER ) 

SHARED,  READONLY 

Alternately,  the  programer  can  include  'HEXDAT.TYP'  and  'HEXTERR.OPN'  from  the 
terrain  text  library  on  DBO:  of  the  CGF  Vax. 

2.  Areal  data. 

a.  Location.  Each  10  km  square  of  surface/elevation  data  occupies  one 
file  in  sav-set  32UDAT.BCK  on  tape  818  in  the  CGF  library. 

b.  File  structure.  Each  file  contains  one  20,000-byte  record. 

c.  Record  structure.  Each  record  contains  10,000  1*2  words  representing 
the  100m  grid  for  the  given  10  X  10  km  area,  written  columnwise.  The  data  for 
each  point  is  packed  as  elevation*  8  +  feature  code. 


d.  Access  methods.  The  required  open  statement  is  "OPEN  (UNIT=LU,FILE= 
fname)"  where  "LU"  and  "fname"  are  the  logical  unit  and  name  of  the  file.  The 
required  read  statement  is  just  “READ(LU)  A"  where  A  is  a  100  X  100  1*2 
array.  If  the  data  is  placed  into  a  400  X  400  array  (to  represent  a  40  km 
square)  then  the  functions  IQOOE  and  IELV  from  the  TERRAIN  library  may  be  used. 

3.  Linear  data. 

a.  Location.  Copies  of  the  linear  databases  produced  by  BOM  are  on  tape 
#820  in  save-set  VECTOR.  8CK  in  the  CGF  tape  library. 

b.  File  and  record  structure.  The  following  description  was  obtained 
from  BOM  as  a  clarification  of  their  documentation.  The  only  change  here  from 
the  original  documentation  is  that  word  4  of  the  link  record  contains  the  y, 
x,  coordinates  of  the  terminus  of  that  link. 

Supplementary  Notes  on  the  Loc  Data  Base 

These  notes  are  intended  to  clarify  and  expand  upon  the  technical 
description  of  the  data  base  which  was  previously  delivered.  Questions 
concerning  physical  and  logical  record  sizes  and  record  structures  have  been 
specifically  addressed  along  with  a  few  other  items  which  were  thought  to  be 
of  interest. 

DATA  BASE  COORDINATES 


Throughout  the  Loc-Terrain  data  base  the  rectangular  coordinates  of  points 
are  specified  in  20  meter  units  offset  from  an  easting  of  9°  (500,000)  (the 
central  meridian  of  U1M  zone  32)  and  a  northing  of  5,600,000  meters  (relative 
to  the  equator).  This  implies  that  MGR  coordinates  are  easily  converted  to 
data  base  coordinates  by  a  simple  offset  and  division  by  20,  provided  that  the 
point  in  question  is  within  UTM  zone  32.  For  points  outside  of  thi s  zone,  the 
procedure  used  in  generating  the  data  was  to  translate  the  given  UTM 
designation  to  GEOREF  (Lat/long)  and  then  convert  back  to  UTM  coordinates 
relative  to  zone  32.  The  routines  necessary  to  accomplish  this  are  included 
with  the  software  delivered  with  the  data  base. 

GRID  INDICES 

GRID  (65,65)  is  the  10-km  grid  whose  southwest  corner  lies  at  the  origin 
of  the  data  base  (32UNB00).  Thus  if  (x,y)  is  the  data  base  representation  of 
a  point,  then  the  formula  I  =  (X+32500)/500  and  J=(Y+325000)/500  (using 
integer  division)  provide  the  appropriate  index  GRID  ( I ,  J)  with  which  to 
reference  the  data. 
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TYPE  CODES 

Data  for  type  of  node  and  type 
NODES 

1  -  intersection  of  autobahns 

2  -  built-up  area 

3  -  airfield 

4  -  open  area 


r  • y' 


of  link  were  encoded  as  follows 
LINKS 

1  -  autobahn 

2  -  main  road 

3  -  secondary  road 

4  -  fair  weather  road 

5  -  rai 1  1 ine 

6  -  ferry 

7  -  ford 

8  -  heavy  bridge 

9  -  dam 

10  -  road  tunnel 

11  -  rail  tunnel 

12  -  major  river 

13  -  minor  river 

14  -  stream 


LUC  OATA  FILE  SPECIFICATIONS 


The  eight  LOC  files  have  the  same  basic  organization.  They  are  each 
composed  of  logical  records  which  are  500  1*4  words  in  length.  Furthermore, 
each  is  structured  as  a  two-dimensional  array. 

GRID  FILES:  Contain  pointers  to  the  node  files 

LEN6TH  -  NEWG.DAT:  33  logical  records  (16500  words) 

NEWHG.DAT:  33  logical  records  (16500  words) 

ARRAY  STRUCTURE  -  128  X  128 

POINTERS  -  Each  entry  is  either  0  (indicating  no  data)  or  else  it 
contains  a  pointer  to  the  first  node  in  the  specified  grid. 

NODE  FILES:  Contain  linked  lists  of  nodes  belonging  to  a  given  grid. 

LENGTH  -  NEWN.DAT:  1845  logical  records  (922500  words) 

NEWHN.DAT:  35  logical  records  (17500  words) 

PR  RAY  STRUCTURE  -  5  X  N  (N =100=  (number  of  logical  records)) 

Entry  (1,J)  in  this  array  contains  information  about  node  J. 

(I,J)  =  pointer  to  the  next  node  in  this  linked  list 
(2,J)  =  code  for  this  type  of  node 
(3,J)  =  pointed  to  first  link  terminating  at  this  node 

(4,J)  =  pointer  to  first  link  originating  at  this  node. 

(5,J)  =  X,  Y  coordinates  of  node  location  (X  is  in  the  lower 

half  word) 

POINTERS  -  A  zero  entry  indicates  the  end  of  a  linked  list 

LINK  FILES:  Contain  linked  lists  of  inlinks  and  outlinks  for  a  given  node 

LENGTH  -  NEWL.DAT:2698  logical  records  (1349000  words) 

NEWHL.DAT:35  logical  records  (17500  words) 

ARRAY  STRUCTURE  -  5  X  N  (N  =  100* (number  of  logical  records)) 

En try  ( I , J )  in  this  array  contains  information  about  link  J. 

(1,0)  =  pointer  to  next  inlink  in  this  linked  list 
(2,J)  =  pointer  to  next  outlink  in  this  linked  list 
(3,J)  =  length  of  this  link  (in  20  meter  units) 

(4,J)  =  coordinates  of  end  node 

(5,J)  =  pointer  to  list  of  subnodes  which  describe  this  link 
POINTER  -  A  zero  entry  indicates  the  end  of  a  linked  list  except  for 
(5 , J)  in  which  case  it  would  imply  that  no  subnode  list  is  associated 
wi  th  this  link. 

SUBNODE  FILES:  Contain  a  concatenation  of  the  subnode  lists  associated  with 
links  in  the  link  files. 

LENGTH  -  SUB.DAT:3977  logical  records  (1988500  words) 

HSUB.DAT:299  logical  records  (149500  words) 


ARRAY  STRUCTURE  500  X  N  (N  =  number  of  logical  records) 

The  array  structure  imposed  upon  this  file  has  no  direct  relevance  to 
the  data  stored  within  it.  The  primary  function  is  to  allow  the  data  to  be 
accessed  by  the  same  mechanism  used  by  the  other  files.  The  pointers  to  this 
file  from  the  link  file  are  separated  into  a  record  pointer  (lower  half  word) 
and  a  word-within-the-record  pointer  (upper  half-word). 

SUBNODE  LIST  STRUCTURE  -  The  first  word  of  a  subnode  list  contains  twice 
the  number  of  subnodes  in  this  list.  If  this  number  is  N,  the  next  N2  words 
contain  X,Y  coordinates  which  describe  the  associated  link.  Note  that  X  is 
contained  in  the  lower  half-word. 

c.  Access  methods. 

(1)  The  user  may  use  routines  supplied  by  BDM  with  the  LOC/terrain 
documentation  or  he  may  use  the  routines  GRIDS,  IGRID,  GETNDS,  and  GETREC  from 
the  Terrain  library. 

(2)  For  accessing  this  data  from  a  lower  level  the  user  is  referred 
to  BDM  LOC/Terrain  documentation. 
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PROGRA*  BDMFX1' 


* 

* 

* 

* 


THIS  PRJGkA.1  wAS  ADAPTED  FROM  A  ROUTINE  R  H  I  CH 
ORIGINALLY  D  I  SPLAYED  THE  BOM  LOC  DATA. 

TiIS  VERSION  TRANSFERS  TERRAIN  DATA  FROM 
THE  FILE  TFkUTM  TO  10  KM  FILES. 


I NTEGER*4  I  ,  J  ,  X  ,  Y 
INCLUDE  'GRID.CMN' 

************************************************* 

*  GRID  CONTAINS  THE  POINTERS  TU  THE  10-KM  * 

*  TERRAIN  RECORDS  I N  THi-.  FILE  TERUTM.  * 

INTEGERS  GRIU(l2b,l?B) 

CDmmON/GRIO/GRID 

************************************************* 


CALL  1NF0(LUIN,LU0UT) 

*  READ  IN  GRID  FILE 
CALL  GRIDR(LUIN) 

*  TRANSFER  THE  INDICATED  RECORDS  FROM  TERUTM  TO 

*  THE  SMALLER  FILES. 

CALL  MOV£REC(LUIN,LUOUT) 

END 


I 
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SUBROUTINE  FI  X  (  A  ) 

**»*t*************»*»****************4»*'*«  **9***************** 

THIS  SUBROUTINE  'FIXES'  THE  Akh A  Y  A  Hi  THAT  THE  FEATURE  * 
AMD  ELEVATION  COOES  ARE  REPACKED  AS  FEA+8»ELE  AND  * 

THE  ARRAY  IS  TRANSPOSED.  * 

944*9999499994»94*49*9**4*4***9*44«4*4****49*9994*4»9**********9 

IMPLICIT  1 NTE3ER*2  (A-Z) 

DIMENSION  A ( 1 0  0 , 100) 

DO  J=l,100 

DO  1=1,100 

1C0DE=ISHFT(A(I , J),-12) 
lELV=Afl,J)-ISHFT(I CODE ,12) 

ICOOEsRECUDEt I  CODE) 

IF( 1 FLV.LE.O. OR. IELV.EQ. 4095) THEN 
ICM  =  1CNT*1 
I ELV=0 
END1F 

A(I,J)=1C0DE4B*IELV 


SUBROUTINE  GKIL)H(LUIN) 

*********4***** ******************************** 

*  ROUTINE  OPENS  THE  FILE  ' TERUTM '  AND  * 

*  READS  THE  GrID  RECORDS.  * 

*********************************************** 

INCLUDE  'GRID. CRN' 

************************************************* 

*  GRID  CONTAINS  THE  POINTERS  10  THE  10-KM  * 

*  TERRAIN  RECORDS  IN  THE  FILE  Tt.RU  TR .  * 

INTEGER*2  GR I U ( 1 2 8 , 1 2b ) 

COMMON/GRID/GRID 

************************************************* 

****************************************************** 

OP£N(ACCESS='DIKECT',ASSOCIATEVARlABLEsIAV, 

♦  BLOCKSIZES20008, FORMS 'UNFORMATTED', 

♦  M AXR ECs90 000, NAME* 'DB1 : [ WALTER J TERUTM.DAT', 

♦  HECORDSIZE=5002,RECORDTTPE='FIXED', 

♦  riPE='OLD',UNlT=LUT,EXTENDSIZE=l .SHARED) 

♦♦*»****♦**+****#»* 

READ(LUIN'l)  C  (GRIDd,  J)  ,Isl,128),  Jsl  ,64) 
REAl)(dUIN'2)((GRID(I,J),I  =  1  , 1  28  )  ,  Jsb5 , 1 28  ) 

OPEN (NAMES 'STATS', TYPE* 'NER',UNITs3) 

RETURN 
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SJHROUTUE  IN*  OlLUlN,LU JUT) 

********************************************** 

*  pnoNprs  the  user  for  necessary  info  * 

********************************************** 

INCLUDE  'GRAPh.CMN' 

1  ************************************************* 

1  *  THE  MIN  AND  MAX  COORDINATE  VALUES  * 

1  COM MO 7  /GkAPH/XMlN,XMAX,YMlN,YMAX,lNT 

1  ************************************************* 

PRINT*, 'ENTER  THE  EASTING  AND  NORTHING  OF  THE  S«  CORNER' 
READ*,XmIn, Y*iN 

PRINT* , 'NOW  ENTER  THE  EXTENTS,  again  IN  METERS.' 
print*, 'easting:' 

READ*,XTN1 

PRINT*, 'northing: ' 

READ*, YTNT 
XMAX=XM1N*XTNT 

PRINT*, 'Enter  THE  LOGICAL  UNIT  NUMBER  OF  1  HE  INPUT  FILE' 
READ*, LOIN 

PRINT*, 'ENTER  THE  LOGICAL  UNIT  NUMBER  OF  THE  OUTPUT  FILE' 

READ* ,L JOUT 

YMAX=YMlNtYTNT 

RETURN 

End 
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SUBROUTINE  MOVERFC(LUlN,LUOUT) 

THIS  SUbR JU II  imE  IS  DESIGNED  TO  MOVE  DtSlGNArtu  * 

*  RECJRDS  FkJ M  THE  FILE  '  TF.KUTM  .LaT  '  TO  1  OKM  * 

*  FILES.  * 

*  inputs:  lUin,luout — uOgical.  unit  numbers  * 

INTEGER* 2  BUFR(  10004)  ,SOUARE(  100,100) 

CHAhACTER*7  MGR 
L JG1CAL*1  ERR 
I NTEGER  *4  x,y,i,j 
INCLUDE  'GRAPH. CMn' 

*  THE  MIN  AND  MAX  COOkDl NATE  VALUES  * 

common  /Graph/xmin, x m a x , y  m  1 n , y  m  ax , int 

INCLUDE  'GR1D.CMN' 

************************************************* 

*  GRID  CONTAINS  THE  POINTERS  TO  THE  lO-KM  * 

*  TERRAIN  RECORDS  IN  IHE  FILE  TERUTM.  * 

INTEGER*2  GH I D ( 1 2  b , 1 2  a ) 

C JMmON/GRID/GRID 


c... 
c... 
c .  .  . 

c... 

c... 

c... 

c 


EQUIVALENCE  CBUFR(S) , SOU A RE ( 1 , 1  )  ) 

FOR  EACH  GRID 

10KM  ARE  SUBTRACTED  TO  INDICATE  THE  S*  CORNER  OF 
THE  LAST  BLOCK. 

DO  X=XMiN,XrtAX-lO0O0, 10000 

DISTANCES  ARE  MEASURED  IN  UNITS  OF  20  METERS  FROM 
AN  ORIGIN  OF  500000M  N,  b6u0000M  E.  THE  ORIGIN 
CORRESPONDS  TO  GRID  INDICES  OF  (65,651  IN  TERUTM. 

DO  Y=YMlN, XMAX-lOOOO, 1 0000 
CALL  1GKJD(X,Y,I,J) 

PkINT*,GRID(I ,J) ,1 , J  I 

IF(GR1D(I,J).NE.0)THEn 

R£AD(LUIN'GRID(I,  J)HbUFR(K)  ,K  =  1,10004) 

CALL  FIX( SQUARE) 

CALL  UTm2mGk(X, Y, MGR, ERR) 

OPEN  (  UNI  TsLUOUT,  NAM t=MGR , STATUS* ' NEM ' ,  FOR M  =  ' UNFORM 

*  K 1  i’  E(LUOUT)SjUARE 

CLOSE(UnIT-LUOUT) 

PRINT*, MGR, X, Y 
END1F 

NkITE(3,*)MGR 
MRITE13,*) (BUFR(K) ,K=1 ,4) 

*«ITE(3,*)'GRID(1 , J) ',GRID(1, J) 

NRITE13,*)  '  ' 

PRINT*, X, Y 

ENDDJ 

ENDOO 

RETURN 


IT 


FUNCT iU\  rECOdEI  I  ) 

THIS  F  U  N  C 1  IJN  TRANSLATES  THl  13 

CJOES  USED  IN  THE  KOM  TERUTM  t  1LE  UTU  THt  3 

CODES  USED  IN  ThF  CORulVEM  TERRAIN  UlSPLAi  FILE 

INPUTS:  I--  TrlE  OLD  CODE 
DjrpUTS:  KECJuE--  THE  NE*  OnE 

******* 

IMPLICIT  1NTE3F.H*2(A-E) 

IF(l.EO.O)  T H F. N 
1  =  4 

NO  DATA  * 

ELSE 

1FII.EJ.1.JK.I.EJ.2)1HEN 

1=2 

urban  * 

ELSE 

IF(1.3E.3.AND.I.L£.S)fHEN 

1  =  1 

FOREST  * 

ELSE 

OPE  <  =  7 ,HEATH/bRUSH  =  6  ARE  UNCHANGED  * 
IFCl.E'J.BJTHEN 
1  =  3 

MARSH  * 

ELSE 

1 E  t I . EU . 4 ) THEN 
1=5 

water  * 

ELSE 

1F(I.GT.9) THEN 
1  =  4 

HAD  DATA  IS  NO  DATA  ♦ 

ENDIF 
EnDIF 
ENDIF 
ENDIF 
ENDIF 
ENDIF 
RECODE=i 
RETURN 


SdbKJUTiNfe;  l*»/iNSPJSEU) 


DISPLAY  CALLING  SEQUENCE 


DISPLAY 

- SETCOLOR 

- SETGEO* 

- INFO 

- UNGEN* 

- MAPPER* 

• - PATCH  IT 


FILLUP* 

FEATURES* 


♦TERRAIN  SYSTEM  UTILITIES 


Figure  B-3. 


PROGRAM:  DISPLAY 


Irilb  KjOTiNE  UlbPLAtfS  Trit  CURUlVEM  UlbPLAH  * 
DATA  IN  4oKm  SQUARES.  '  * 


CrtAKACTEHM  ANS 
Call  SE1CUL0R 
Call  strcito 

CJNl'lNUe. 

CALL  INFO 
CaLL  ON oCN 

Call  mapper 

CmLl  CMCLJS 

PRINT*, 'CORRECTIONS  TU  FEATURES?' 
REAuCb, 10J  mNS 
FORMA! ( 1 Ai  ) 

CALL  CMOPEN 
IK  lANS.Ej. 'T'JIHtN 
CALL  PATCH1TIANS) 

EnDIF 
GJTul 1 


0001  SJBKOUTINt  INFO 

02  ************************************************************ 

Oi  *  THIS  ROUTINE  JUST  QUERIES  THE  OPERATOR  AS  TO  WHICH  * 

04  *  DISPLAYS  HE  HANTS.  * 

Ob  IMPLICIT  I NTE3ER*  2  (1-N) 

07  INCLUDE  'WInOO.CMN' 

08  1  ************************************************************** 
09  1  *  FWINXY  CONTAINS  THE  X  MIN  A,«D  MAX  AND  THE  Y  MIN  AND  * 

10  1  *  MAX  RESPECTIVELY  FOR  THE  *1ND0W.  MIN  AND  MAX  REFER  * 

11  1  *  TJ  THE  NIn  AND  MAX  OF  ELEVATION  VALUES,  AND  ZDELT  IS  * 

12  1  *  T-»E  CONTOUR  IN1ERVAL.  * 

13  1  ************************** 

14  1  DIMENSION  FwINXY (4) 

lb  1  CJMMOn/*InOO/FHINXY, MIN, MAX, ZDELT 

lb  1  ************************************************************** 

17  INCLUDE  'ANSWER. CMN' 

18  1  ************************************************ 

19  1  CHAKACTER*1  FEA ,  CON 

20  1  COMMON/ANSHER/FEA,CON 

21  1  ************************************************ 

22  INCLUDE  'CORNER. CMN' 

23  1  *********************************************************** 

24  1  *  SWX,SwY  ARE  THE  SOUTHWEST  UTM  COORDINATES  OF  THE  * 

25  1  *  AREA  IN  THE  ARRAY  IBUF.  * 

2b  1  1NTEGERM  SwX,S*Y 

27  1  C0MM0N/C0RNER/SWX,SWY 

28  1  *********************************************************** 

29  PRINT*, 'ENTER  THE  COORDINATES  OF  THE  SM  CORNER  ' 

30  REAO*,S«X,S*Y 

31  FWlNXY(l)=S*X 

32  FWlNXY(2)sFwlNXYCl)*40000 

33  FwINXY C  3)=SWY 

34  FWINXY(4)sFWINXY(3)+40000 

35  PRINT*, 'FEATURES?' 

3b  10  FORMAT ( A1 ) 

37  READ( 5 ,10)  FEA 

38  PRINT*, 'CONTOURS' 

39  READ( 5,10) CON 
IFtCON.EQ. ' Y'JTHEN 

PRINT*, 'CONTOUR  INTERVAL?' 

2  READ*, ZDELT 

3  E«DIF 
RETURN 


0001 

SUBROUTINE  PATCHlTt  ANSWER) 

0002 

*♦* ************************** ************************* 

0003 

* 

A  KLUDGE  TO  PaSS  DATA  FROM  POLYDEF  TO  FILLUP  ♦ 

0004 

****************************************************** 

0005 

INCLUDE  'CORNER. CMN' 

000b 

1 

*********************************************************** 

0007 

1 

* 

S*X,S*Y  ARE  THE  SOUTHWEST  UTM  COORDINATES  Of  THE 

* 

000« 

1 

* 

AREA  IN  THE  ARRAY  IBUF. 

* 

0009 

1 

I NTLGER  *4  SW  X , S# Y 

0010 

1 

COMMON/ COR NER/S*X,SNY 

0011 

1 

*********************************************************** 

0012 

INTEGER*2  1CLR.1NCR 

0013 

DIMENSION  POLY (500*2) 

0014 

CHARACTER* 1  ANSWER 

0015 

DJ  WHILECANSWER.EO.  'Y') 

001b 

PRINT*, 'COLOR?' 

0017 

READ*, ICLR 

OOlb 

CALL  CMOPEN 

00 1 9 

CALL  P3LYDEF(N,P0LY,1CLK) 

0020 

DO  1  =  1, N 

0021 

POLY(I,l)=POLYll,l)-SbX 

0022 

P0LYII,2)=P0LY( I, 2) -SHY 

0023 

EnDOO 

0024 

CALL  F1LLOP(N,POLY,ICLR) 

0025 

I nCk=1 

0026 

CALL  FEATURES (INCH) 

0027 

CALL  CMCLOS 

002b 

PRINT*, 'ANOTHER  PATCH?' 

0029 

1  0 

FJRMAKAl  ) 

0030 

READC5, 10)  ANSWER 

0031 

ENDDO 

0032 

CALL  GEN 

0033 

RETURN 

0034 

END 
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SUBROUTINE  POLYDi'F ( I , VERTEX , 1CLR) 
*************************************************************** 

*  THIS  SUaRjUTlNE  DISPLAYS  A  USER-DEFINED  POLYGON,  * 

*  AND  RECORDS  THE  COORDINATES  OF  THE  VERTICES  IN  * 

*  THE  ARRAY  VERTEX.  NO  MORE  THAN  500  EDGES  ARE  ALLOWED.  * 
************************************************  *****  ********** 

*  INPUTS:  ICLR—  THE  LINE  COLOR  TO  BE  USED;  0-7  * 

*  OUTPUTS:  VERTEX—  THE  ARRAY  OF  VERTICES  * 

*  1—  THE  NUMBER  OF  VERTICES  * 


*************************************************************** 

I NTEGER  *2  1CLK 
INTEGERM  IMAXPT  ,  IPT,  1RET 
DIMENSION  VERTEX  C  500 , 2 ) 

DATA  IMAXPT/1 / 

CALL  CMCLOS 

PRINT*, 'TERMINATE  POLYGON  DEFINITION  BY  ENTERING  0  AT 
♦  THE  LAST  VERTEX.' 

CALL  CMOPEN 
CALL  LINCLR(ICLR) 

C 

1  =  1 

DJ  WHILE  (I. LI. 500) 

CALL  LOCATE! IMAXPT , PX , PY , I  RET, IPT) 
lFci.Gr.nrHEN 

CALL  MOVE! VERTEX (1-1,1 ) , VERTEX (1-1 ,2)  ) 

CALL  DNAW(PX,PY) 

ENDIF 

VERTEX ( I f 1 ) *PX 
VERTEX(I,2)=PY 
1F(IRET.EQ.48)TH£N  iASCII  0 

CALL  DRAM! VERTEX! 1 , 1 ) , VERTEX! 1 , 2  )  ) 

1*1  +  1 

VERT£X(Iyl)=VERTEX(l , 1  ) 

VERTEX! I ,2)*VERTEX( 1,2) 

CALL  CMCLOS 
RETURN 
ENOIF 
1  =  1  +  1 
ENDDO 
END 
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0001  SUBROUTINE  SETC3LUR 

0002  I******************************************** 

0003  *  SETS  COLORS  AND  SPECIFIES  THE 

0004  *  TEKTRONIX  402/  AS  THE  GRAPHICS  DEVICE 

ooos  *♦***♦*♦*♦*♦***♦♦***♦♦*******♦*♦**♦♦*♦*♦***** 

000b  DIMENSION  BLUE { 3 ) 

0007  PEAL  LTBLUE(3),LTGREEN(3) 

0008  DIMENSION  GREEN ( 3 ) , BKGRND ( 3 ) , RED { 3 ) , BLACK ( 3 ) 

0009  DIMbNSIJN  YELLOn ( 3 ) 

0010  DATA  YELLJW/luO. , 100. ,0./ 

0011  DATA  GREEN/20. ,60., 5. /, BKGRwD/30. , 30. ,30./ 

0012  DATA  RED/30. ,10. ,10./, BLACK/0.,0.,0./ 

0013  DATA  BLUE/O. , 0., 100. / , LTGKEEN/30 . , 80. ,30./, 

0014  ♦  LTBLUE/O. , 70. , 100./ 

0015  C 

0016  IDEV ICE=4027 

0017  I3PT=5 

0018  CALL  GRSTRTCIDEVICE,  10PT) 

0019  CALL  CLRMAP(0,1, YELLOW) 

0020  CALL  CLRMAPC1,1, GREEN) 

0021  CALL  CLRMAP(2,1,RED) 

0022  CALL  CLRMAP(3,1,LTBLUE) 

0023  CALL  CLRMAP(4,1, BLACK) 

0024  CALL  CLR*AP(5,l,bLUE) 

0025  CALL  CLHMaP16,1 , LTGREEN) 

0026  CALL  CLRMAP(7,1, BKGRND) 

0027  CALL  BK GCLR ( 7 ) 

0028  C 

0029  RETURN 

0030  END 
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DRWHEX  CALLING  SEQUENCE 


DRWHEX 

L 


■HXGRD  IN  IT 

' - MXINIT* 


GRIDINIT 

- DRWGRD 

- MARKER 

- SETOEV 

HEXGEN 

SETHXGRD 

i 

4 -  HEXREAD* 

DRWHXGRO 


- DRW* 

- UNPACKER* 

DRWROADS 

- - UNPACKER* 

DRAWROADS 

- GRIDR* 

- I GRID* 

- DRWREC 

- GETNDX* 

1 - GETREC* 

1 - DRWLNK2 

; -  GETNDX* 

| - GETREC* 

i - GETSUB* 

f 

» 

1 - TRANX* 

I 

! - TRANY* 

i 

1 - ORWNQO 


FIXER 

REPACK* 


TRANX* 

TRANY* 


*  TERRAIN  SYSTEM  UTILITIES 
Figure  B-5. 
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*  JUM  *  J  J 


PROGRAM:  DRWHEX 


UNPACKER 


DO  1 
002 
DOi 
D04 
D05 
DOt> 
D07 
DOS 
DO* 
DIO 
Dll 
D1  2 
D 1  i 
D 1  4 
D 1 5 
Dio 
D17 
D 1  8 
D 1 9 
D20 
1 


SUBROUTINE  UR*NOD(NOD) 

*  THIS  ROUTINE  EXTRACTS  THE  XY  COORDINATES 

*  OF  THE  TERMINUS  AND  DRA#S  FROM  THE  LAST 

*  SURNOOE  TO  THE  TF.RMINuS. 

*********t*«******««*t*>t************************** 

*  INPUTS;  NOD  — THE  PACKED  YX  COORDINATES 
*********** ********* *********** ****** ****** ******* 

I NT£G£R*4  NUD,TMPNOu 
I NTEGER *2  X,Y 
CALL  CM  OPEN 

*  SET  X  COORDINATE  * 

TMPNODsLI6$EXTZV(0,16,NJD) 

CALL  LIB$1NSV(TMPN0D,0,16, X) 

*  SET  Y  COORDINATE  * 

TMPNOU=Llb$EXTZV(16,16,NOD) 

CALL  Lia$INSV(TMPNOD,0,16,Y) 

*  DkAH  TO  THE  END  NODE  * 

CALL  DRAM(TRANX(X) ,TRANY( Y) ) 

CALL  CMCLOS 

RETURN 
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0012 
0013 
0014 
0015 
0016 
0017 
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0020 
0021 
0022 
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0025 

002b 
0027 
0028 
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003b 
0037 
0038 
0039 
0040 
0041 
0042 


SUBROUTINE  DRwREC(HDNODE) 

*  THIS  ROUTINE  DRAWS  THE  ROADNET  FOR  ONE  10-KM  * 

*  SjUARE.  * 

*  INPUTS:  HONOOt —  THE  FIRST  NODE  POINTER  FOR  * 

*  THIS  10-KM  SjUARE  * 

******************************************************* 


I.JTEGERM  HUNODE,  IMPNOD,  NXTNOD 
I M f EGER  *2  X ,  Y , WRDpOS 
INCLUDE  #UT1L:LNKnOD.C«N' 

1  **************************************************************** 

1  *  ARRAYS  FOR  THE  GRl D , NODE , LINK , AND  SUBNODE  FILES  * 

1  **************************************************************** 

1  INTEGERM  GR 1 0  , NQDREC ,  LNKREC  , SUBREC 

1  COMMON  /LNKNOO/GR1D(128,128),NOUREC(5,100),LNKREC(5,100) 

1  +  , SUBREC 1500) 

1  ***************************************************************** 
NXTNODSHONOUE 
DO  drilLE  (NXTNOD.NE.O) 

♦  GET  NODE  RECORD  * 

CALL  GETN DX(  NX l'NOD.NRECNUM,  WRDPOS) 

LU=2 


1  C 
1  C 
1 
1 

1  C 
1 
1 

1  c 


CALL  GETREC(LU,NRECNUM,NODKEC) 

INCLUDE  ' SETX Y . FOR  * 

SET  X  COORDINATE 

TMPNODsLlBSEXTZV (0, 1  6 , NDDREC ( 5 , "RDPDS) ) 
CALL  bI6$INSV(TMPN0D,0, 16, X) 

SET  Y  COORDINATE 

TMPN0D=LI6SEXTZV(16,lb,N0DREC(5, WRDPOS ) ) 
CALL  Ll6$INSV(THPN0D,0,16,Y) 


NXTLNKsN0DREC(4, WRDPOS) 

DO  WHILE  (NX  TLNK . Nb . 0 ) 

*  DR«LNK2  DRAWS  ONE  'OUTLINK'  AND  * 

*  GETS  THE  NEXT  LINK  POINTER  * 

CALL  DRWLNK2(X, Y, NXTLNr) 

ENDDO 

nXTN0D=N0DREC(1, WRDPOS) 

ENDDO 

RETURN 
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SUBROUTINE  DR*ROAuS 


THIS  ROUTINE  DRAWS  THE  HEX  'ROADS'  FOR  * 
EACH  OF  A  SPECIFIED  SET  OF  hEXES.  IT  * 
ORAwS  FROM  THE  CENTER  TJ  THE  SIDES  OF  * 
EACH  HEX.  IT  IS  LIMITED  TO  A  LEVEL  8  * 


*  HEX  HI  THE  SIZES  OF  ThE  ARRAYS  IN  HXSTOR.CMN  * 

******♦**************+**********♦********************** 

IMPLICIT  INTEGEK*4(H,P) 

INCLUDE  'UTIL:UNPACK.CMN' 

****************************************************** 

INTEGERS  HS I DE  ( 6 )  •  CONNECTIVITY  CODES  IN  * 

•  NUMERICAL  ORDER  bY  SIDE  * 

common /jnpack/hsidf 

*4* ******  ********  ****** ******************************* 

INCLUDE  'HXST3R.CMN' 

************************************************************ 

*  THERE  ARE  2401  LEVEL  4  HEXES  IN  A  LEVEL  8  HEX  * 

INTEGEKM  HXNO(240l)  !  1HE  INTERNAL  HEX  NUMBERS  * 

I NTEG£R*4  S(6)  !  S  INDEXES  THE  HEX  SIDES  * 

•  IN  COUNTERCLOCKWISE  ORDER  * 
I NTEGER*4  HXSIDES(2401 )  ‘PACKED  HEX  CONNECTIVITIES  * 
DIMENSION  XY(240l,2)  !  THE  XY  COORDINATES  OF  THE  * 

•  HEX  CENTERS  * 

COMMON  /HXSTOR/HXN,HXNO,S,HXSIDES,XY 

************************************************************ 
INCLUDE  'HXGRU.CMN' 

**************************************************** 

*  PARAMETERS  USED  IN  DRAWING  THE  HEXES  AND  * 


Trit  LOC  OATA  * 

*************************************************** 
PI  3.14159  * 

X,Y  THE  RELATIVE  POSITIONS  DF  THE  HEX  * 

VERTICES  * 

RAD  RADIUS  IN  METERS  OF  A  HEX  * 

PHI  RELATIVE  ROTATION  TO  THE  START  OF  * 

THE  HEX  DRAW ;  ie ,  THE  'BOTTOM'  * 

X PHI ,  THE  RELATIVE  DISTANCES  TO  THE  START  * 
YPHI  OF  THE  HEX  DRAW  * 


**************************************************** 

REAL  PI , PSI ,  PHI 

C0MM0N/HXGRD/XC6) ,Yl6) , RAO, PHI, PI, 

♦  XPHI,YPHI 

**************************************************** 

DATA  S/3, 1, 5,4, b,  2/ 

*  CONVERT  BACK  TO  THE  RADIUS  OF  THE  INSCRIBED  CIRCLE 
RRAD*KA0*S3RT( 3.0J/2.0 

THsPHI-PI/6.0 

*  FOR  EACH  HEX  * 

CALL  CMOPEN 

DO  Isl,HXN 

CALL  UNPACKER(HXSIDESCI) ) 

CALL  VECAbS 

*  MOVE  TO  HEX  CENTER  * 

CALL  M0VE(XYU,1),XY(I,2)) 

*  FOR  EACH  SIDE  * 

DO  0=1,6 
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CALL  VECREL 
TH=TH*Pl/J.O 

IF(HSIDE( SCJ) ) . NE.OJTHEN 
Lr¥P  =  nSlDE(S( J)  ) 

CALL  LI nCLR ( L T¥ P ) 

CALL  DRAW(RRAD*COS(TH) ,RRAD*S1N(TH)  ) 
CALL  VECAbS 

MOVE  10  HEX  CENTER  * 

CALL  M0VE(X¥(1,1),XY(I,2)) 

ENOIF 
NEXT  SIDE 
ENDDO 
NEXT  HEX 
ENDDO 

CALL  VECAbS 
CALL  CMCLOS 
RETURN 
END 
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SUBROUTINE  FIXER 

*************************************************** 

THIS  ROUTINE  *ILL  ADD  OR  DELETE  CONNECTIVITIES  * 

FROM  THE  'HEX I SED  '  LOC  OR  HYDRO  DATA.  * 

*************************************************** 
IMPLICIT  INTEGER  H 
I NCLUuE'UrlLl PACKER. CRN' 

***************************************************** 

I NTEGER  *4  SIDES  !  PACKED  CONNECTIVITIES  * 

INTEGERM  LTYPE  *  CONNECTIVITY  FOR  CURRENT  SIDE  * 
COMMON / PA CK/S I DES, L TYPE 

***************************************************** 

INCLUDE  'UTIL:UnPaCK.CMN' 
************************************************* 

INTEG£R*4  HSIDEC6)  !  CONNECTIVITY  CODES  IN  * 

•  NUMERICAL  ORDER  BY  SIDE  * 

COMMON /UNPACK/HS IDE 

************************************************* 

INCLUDE  'TYPE.CMN' 

********************************************** 

LOGICAL  LOC  •  TYPE=ROADS  ♦ 

LOGICAL  HYDRO  •  T YPE=Kl VERS  * 

COMMON /TYPE/ LOC, HYDRO 

********************************************** 

DIMENSION  HST JR ( 2 ) 

CHARACTER  AnS 

InTEGER*2  ICHAR 

DIMENSION  XCEnTR(2) ,YCEnTR(2) 

DIMENSION  ICHARC2) ,PX(2J ,PY(27 
OATA  IMAXPT/2/ 

INCLUDE  'GRAPH. CMN' 

************************************************* 

REAL  XM1N,XMAX,YMIN,YMAX  !  nINDOR  BOUNDARIES  * 

I  IN  METERS  * 

INTEGER  I  NT , LEV  i  INTERVAL  FOR  ACCESSING  THE  * 

I  DATA  AND  LEVEL  OF  HEX  ♦ 

common  /graph/xmin,xmax,ymin,ymax,int,lev 
************************************************* 

LEV  =  4 
AnSs'Y' 

LTYPEsO 
LJ  =  7 

CALL  CMCLOS 

PRINT*, 'ENTER  9  TO  STOP.' 

DO  mHILE(ANS.EQ.'Y') 

DO  *H1LE(LTYPE.NE.9) 

CALL  CMOPEN 

CALL  LOCATE(lMAXPT,PX,PY, ICHAR, IGOT) 

DO  1=1,2 

X=PXII)-500000. 

Y=PY(I)-5700000. 

CALL  XYL2HACX, Y , LEV , HSTOR ( I ) ) 

CALL  HA2XYL(HST0R(1) ,XCENTR(I) , YCENTR(I) ,LEV) 
XCEnTNI I )=XCENTR( I )+500U00 
YCEnTR(I)=YCENTR(1)+5700000 
ENDDO 

Ll’YPE=ICHAR(2)-48 


Ir(LTYPc.vifc..0.'i'l{).LTYPL.Lfc.3)THtN 
CALL,  KEPACKiHSTOR,LTYPE) 

IF(lOC) THEN 

CALL  MO^E(XCENTK( 1 ) , YCENTk( 1)  ) 

IF(LTYPE.EU.0)LTYPEs7 

CALL  LINCLR(LTYPE) 

CALL  DRAW(XCEnTR(2) ,YCENTR(2)  ) 

EnDIF 

IF( HYDRO) CALL  D«W ( XCENTK ( 2 ) , YCENTR ( 2 ) , HS1DE) 
EMDIF 
ENDD  J 

CALL  CMCLOS 

PRINT*, 'HOKE  CHANGES?' 

READ (5,10  JANS 
IF (ANS.EU. 'Y')LTYPE=0 
ENDDO 

F3RmAT( 1A1  ) 

RETURN 


oooi 

0U02 
0u03 
0u04 
0005 
0006 
0007 
OoOd 
0009 
0010 
0011 
0012 
OOli 
0014 
0015 
001b 
0017 
0018 
0019 
0020 
0021 
0022 
0023 
0024 
0025 
0026 
0027 
0028 
002  9 
0030 
0031 
00  37 


SUBROUTINE  GR1D1N1T 

****************************************** 

*  THIS  SETS  THE  X  AND  Y  COORDINATE  ♦ 

*  LIMITS  AND  THE  GRID  INTERVAL.  * 

****************************************** 

INCLUDE  'DISPLAY. CMN' 

************************************************************* 

*  X 3  AND  YO  ARE  THE  CENTER  COORDINATES  OF  THE  DISPLAY  * 
************************************************************* 

CJMM0N/D1 SPLAY/  XO,YO 

************************************************************* 
INCLUDE  'GRAPH. CMn' 

****************************************************** 

REAL  XMIN.XMAX, YMIN.YMAX  I  WINDOW  BOUNDARIES  * 

I  IN  METERS  * 

INTEGER  INT,LEV  i  INTERVAL  FOR  ACCESSING  THE  * 

i  DATA  AND  LEVEL  OF  HEX  * 

COMMON  /GRAPH/XMIN, XMAX, YMIn, YMAX, InT.LEV 
****************************************************** 
DIMENSION  LE VL ( 4 ) 

DATA  LEVL/1,1,1,4/ 

L=LE V - 3 

*  SET  THE  X  AND  Y  LIMITS.  * 

XMlN=XO-LEVL(L)*lOOOO 

YNIN  =  YO-LEVL(L)  *100U0 

XMAX=XO+LEVL(L) *10000+1 

YNAX=YO+LLVl(l) *10000+1 

InT=1 0000 

CALL  SETDEV 

CALL  DRwGRD 

RETURN 
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SET  ELSEMK 


MUST  ASK  FUR  AI  LEAST  ONE  LEVEL 


SUBROUTINE  HEXGEN(HXN ,HXNO, LEVTUP, LEVBQT) 
***************************************************** 

THIS  ROUTINE  GENERATES  HEX  MiM-l-  i  ;  FROM 
'LEvTOP'  TO  'bEVBUT', NESTED  1  *  HE*  FASHION. 

♦  l****************#*^****************************#** 

INPUTS:  LEVTOP—  THE  HIGHEST  i.EVf.L  OF  HEX 

TO  BE  GENERATED 

LEVB01--  THE  LEVEL  TO  BE  USED  IN 
FILLING  THE  HEX  TREE 

OUTPUTS:  HXN  --  THE  NUMBER  OF  HEXES  GENERATED 
HXNO  —  THE  ARRAY  OF  HEX  NUMBERS 
***************************************************** 

I MPLICI I  INTEGER  (H,P) 

DIMENSION  LE VSTQP ( 4:10) 

DIMENSION  HXNJ(2401) 

I N  TEGERM  ZERO 

C...  TrtE  VARIABLE  'LEVMlN '  SHOULD  BE  (AND  PROBABLY  IS) 

LEVMIN=4 
Z£RO=77777777 
L=LEVT0P-lEVB0T 
IFCL.EU.OJTHEN 

PRINT*, 'ERROR  IN  HEXGEN ' 

RETURN 
ENDIF 

HXN=7**(L-1)  i  YOU 
DO  1=4,10 

LEVSTOP(I)=0 
ENDUO 

DO  I=LEVB0T,LEVT0P-1 
LE VSTOP ( 1 ) =6 
ENDDO 
HXN  =  0 

C...  IF  LEVST0P(LEVEL)=0  THE 

C...  THE  DIGIT  SUBTRACTED  IS 

DO  LEV10=0,LEVSTOP( 10) 

LI 0=LEV10*1000000 
DO  LEV9=0,LEVST0P(9) 

L9=LEV9*1 00000 
DO  LEV8=0,LEVST0P(8) 

L8  =  LEV8M0000 
DO  L£V7=0,LEVSTOP(7) 

L7=LEV7*1000 
DO  LEVb=0,LEVSTOP(6) 

L6=LEV6*100 
DO  LEV5=0,LEVST0P(5) 

L5=l U*LEV5 

DO  LEV4=0,LEVST0P(4) 

L4=LEV4 

HXNsHXN+1 

HXN0(HXN)=ZER0-L10-L9-L8-L7-L6-L5-L4 
D  PRINT*, HXN, HXNO(HXN) 

ENDDO 

ENDDO 

ENDDO 

ENDDO 

ENDDO 

ENDDO 
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LOOP  IS  ONLY  EXECUTED  ONCE,  AND 
0 , . . NO  CHANGE 
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PRINT*,  rtXN,(HXNOU),  1  =  1,  HXN) 

OJ  N  =  1  ,  H  X  I* 

CALL  HeX1R(HXN0(n),i,LEVM1N,HSTON) 
HXNO  l  N  J  sHS  l'OK 
ENDDO 
RETUKn 
E4Q 
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SUBROUTINE  HXGRuIMT( LEV  ) 

THIS  INITIALIZES  THE  PARAMETERS  FOR  * 

ACCESSING  AND  DRAwInG  THE  HEX  GRID 

******************************************* #***»**♦*♦ 

OUTPUTS:  LEV —  THE  LEVEL  UP  ThE  HEX  TL  BE  DRAWN  « 
***************************************************** 

INCLUDE  'UTIL: HEX  «CMN  '  j 

*************************************************************** 
FOR  DEFINITIONS  OF  VARIABLES  SEE  HXINIT.FOR 
*************************************************************** 
IMPLICIT  INT£GER(H,P) 

COM MON/HEX/1 HAOUT,NHLEV,M I NLE V , SLTO , CLTO , DLNO , DI AM ( 10) ,  DIAMTR^ 
+  AOFI,YJF1,XOFJ,YUFJ,RIOFX,RJOFX,RIOFY,RJOFY,  jj 

♦  ICON (70) , JCON(70) ,IMAX(7) , JMAX(7) 

********************  ****-.  ***********  **************************  *| 

include  'display. cmn' 

******************************************************** 

XJ  and  YO  ARE  THE  CENTER  COORDINATES  OF  THE  DISPLAY  * 
******************************************************** 
COMMON/DISPLAY/  XO,YO 

******************************************************** 

INCLUDE  'HXGRD.CMN' 

*********************************************** 

PARAMETERS  USED  IN  DRAWING  THE  HEXES  AND  * 

THE  LOC  DATA  * 

*********************************************** 

PI  3.14159  * 

X,Y  THE  RELATIVE  POSITIONS  OF  THE  HEX  * 

vertices  * 

RAD  RADIUS  IN  METERS  OF  A  HEX  * 

PHI  RELATIVE  ROTATION  TO  THE  START  OF  * 

THE  HEX  ORAN; 1 e *  THE  'BOTTOM'  * 

XPHI ,  THE  RELATIVE  DISTANCES  TO  THE  START  * 

Y PHI  OF  THE  HEX  DRAM  * 

*********************************************** 

REAL  PI , PSI ,  PHI 

C0MM0N/HXGRD/X(6),Y(6) , RAD, PHI, PI, 

*  XPHI,YPHI 

*********************************************** 

DATA  PI/3.14159/ 

PRINT* , 'WHAT  LEVEL  OF  HEX  DO  YOU  WANT?' 

READ*, LEV 

print*, 'enter  the  x,y  coordinates  of  the  center' 

PRINT*, 'AS  AN  OFFSET  IN  METERS  FROM  NCOO:' 

READ* , XO, YO 

IT  SEEMS  EASIER  TO  HAVE  THE  OPERATOR  PUT  THE 
COORDINATES  RELATIVE  TO  NCOO,  BUT  ALL  THE  HEX 
UTILITIES  ARE  OFFSETS  FROM  THE  CENTER  HEX. 

XU*500000*XU 
Y3S5700000+YO 

INCLUDE  'UTILlHEXINIT.PHM' 

********************************************************** 

IWRITE:  OUTPUT  DEVICE  FOR  ERROR  MESSAGES 

LEVMAX :  MAXIMUM  LEVEL  OF  HEX  AGGREGATION 

LEVMINS  MINIMUM  "  *  " 

DLT:  LATITUDE  OF  THE  ORIGIN  HEX  IN  FLOATING" 
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*  POINT  DEGRESS  * 

*  .■)!.■» :  LONGITUDE  OF  ORIGIN  HEX  * 

*  LC.VS  ?.:  HEX  LEVEL  AT  WHICH  THE  SCALE  OF  THE  * 

*  HEX  CJ0KD1NATE  SYSTEM  IS  GIVEN  * 

*  SIZHEX:  DIAMETER  OF  HEXES  mT  SIZE  'LEVSIZ'  IN  * 

*  FLOATING" POINT  METERS  * 

I*R1TE=6 

LE VM AX=9 
LEVMINS4 
DbT=5 1*45 
DLN  =  9 . 00 
LEVSIZsb 
SiZHEX-25000. 

CALL  HXlNIT(IwRIT£,LEVMAX,  LEVMIn,  DLT,DLN,  LEVS  1Z, SIZHEX) 
**************************************************************** 
RADsDIAMTK/2.0 

*  #D1AMTR#  IS  THE  DIAMETER  OF  THE  INSCRIBED  CIRCLE 
RAD=2*RAD/SORT(3.0) 

*  PHI  IS  THE  ROTATION  OF  THE  HEX  GRID  FROM  NORTH 
PrtIs(LEVNIN*19.1)*Pi/l80 
XPHI=«AO*COSCPHI) 

YPHlsRAO*SlN(PHI) 

PSI=PHl*PI/3 

*  SET  THE  RELATIVE  POSITIONS  OF  THE  VERTICES 
DJ  1=1,6 

PSI=PSI+PI ✓ 3 
X(1)=C0S(PSI)*RAD 
Y(1)=S1N(PS1)*RA0 
ENDDO 
RETURN 
EwD 


SUBROUTINE  MARKER 

ft********************************************** 

♦  THIS  ROUTINE  JUST  id  R  I  TES  THE  RELATIVE  * 

*  CJOKD1NATES  OE  THE  LO*EK  LEFT  CORNER  * 

*****************$*********4******************** 

INCLUDE  'GRAPH. CMn' 

1  **4444444*44444444444*4444444444444*4444444444444*44*4 

1  REAL  XM1N,XHAX, YMIN,YMAX  !  WINDOW  BOUNDARIES  * 

1  I  IN  METERS  * 

1  INTEGER  INI, LEV  i  INTERVAL  FOR  ACCESSING'  THE  * 

1  !  DATA  AND  LEVEL  OF  HEX  * 

1  CJMMON  /GRAPH/XMlN,XMAX, YMIn, YMAX,INT,LLV 

1  44444*444444444*444444444444444*444*4***44444444**4444 

CALL  CHOPEN 
CALL  rXTCLR(O) 

ISIZEsO 
PX  =  2 


P  1  =  3 

Call  txam 

CALL  TXSIZE(ISIZE,PX,PY) 

*  IMAXX  AND  IMAXY  ARE  THE  NUMBER  OF  DIGITS  IN  * 

4  THE  X  AND  Y  COORDINATES,  RESPECTIVELY.  * 

*  SET  X  AND  Y  TO  THE  UTM  COORDINATES  OF  THE  ♦ 

*  S *  CORNER 
XX=AL0G10(XMIN) 

IMAXX=NINI(AX)+1 
Y  Y  =  ALOG lO(YMIN) 

I*AXY=NINT( YY)+1 

*  PROPORTION  THE  MOVE  RELATIVE  TO  THE  WINDON  SIZE 

*  THE  400  NAS  ARRIVED  AT  HEURISTICALLY 
N=( YMAX-YMlN)/l 0000+1 

CALL  MOVE(XMIN,YMIN+400*N) 

CALL  RNUMBR(XMIN,-1,IMAXX) 

CALL  M0VEIXMIN,YMIN) 

CALL  RNUMBRCYMIN,-1 , IMAXY  ) 

CALL  CMCLOS 
RETURN 


S JBROuTI NE  SETDEV 

M*$***»*«MfMM«*V*d^<  ^ 

*  SETS  GRAPHICS  L«V1RJ.  ^ENT  * 

****************** ***************** 

INCLUDE  'GRAPH. CMn' 

*♦♦»»♦»♦♦♦♦♦♦♦♦ *************************************** 

REAL  XM1N,XMAX, YMIN,YMAX  !  *INDOW  BOUNDARIES  * 

i  IN  METERS  * 

INTEGER  I  NT, LEV  i  INTERVAL  f OK  ACCESSING  THE  * 

1  DATA  AND  LEVEL  OF  HEX  * 

COMMON  >GRAPH/XMIN,XMAX, YMIN, YMAX, I  NT, LEV 
I***************************************************** 
*************************************************** 

*  INITIALIZING  AND  DEFINING  THE  COLORS  USED  * 

*  IN  DRAWING  I  HE  HEX  CONNECTI VITIES  AND  LOC  * 
*************************** ************************ 

DIMENSION  RED1( J) ,RED2(3) ,BLUE1 (3) ,BLUE2(i) 

DIMEN SI  ON  GREEN 1 (3) ,GKEEN2( 3) ,BKGHND(i) , BLACK (3) 

DATA  RED1/30. , 10. , 10./,KED2/30., 10. , 10./ 

DATA  BLUEl/10. ,20. , 1 00 . / , BLUE2/ 1 0 . ,20. , 100./ 

DATA  GREEN  1/20. ,60. , 5 . / , GREEN2/20 . ,60. ,5./ 

DATA  BKGRND/30.,30. , 30 ./, BLACK/O . ,0. ,0./ 
************************************************************* 
IDEVICE=4027 
I0PT=5 

CALL  GRSTRT( IDEVICE,  IDPT) 

CALL  CM  OPEN 
XMNsXMIN-5000 
XMXsXMAX+5000 
.  YMNsYMIN-5000 

YMX=YMAX+5000 

CALL  wINDOW(XMN,XMX,Y«N,YMX) 

************************************************************ 

*  THE  '1'  COLORS  ARE  USED  IN  DRAWING  THE  HEXLOC  * 

*  DATA  AND  I  HE  '2'  COLORS  FOR  TnE  ORIGINAL  LOC  DAIA  * 
************************************************************ 

CALL  CLRMAP(1,1,GREEN1) 

CALL  CLRMAP(2,1, BLUE1) 

CALL  CLRMAPI 3,1, REDl) 

CALL  CLRMAP(4,1 ,RED2) 

CALL  CLKMAP(5,1,BLUE2) 

CALL  CLKMAP(6,1,GRE£N2) 

CALL  CLKMAP(7,1,BKGhND) 

CALL  CLRMAP(0,1, BLACK) 

CALL  BKGCLR ( 7 ) 

* 

CALL  VWPORTC30. ,129.3,0. ,99.3) 

CALL  CMCLOS 
RETJRN 
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SUBROUTINE  SETHXGRD(MINLEV) 

*  SETS  THE  X Y  ADDRESSES  OF  THE  HEXES  * 

*  AND  READS  THE  CONNECTIVITIES  IN.  ♦ 

************************************************ 


*  INPUTS:  NINLEV--  THE  MINIMUM  HEX  LEVEL  * 


IMPLICIT  INTEGER (  H  ,  P ) 

INCLUDE  'HXSTOR.CMN' 

************************************************************ 


THERE  ARE 
INTEGERM 
I  NTEGER  *4 


2401  LEVEL 
HXN0(2401 ) 
S(6) 


HEXES  IN  A  LEVEL  8  HfcX  * 

THE  INTERNAL  HEX  NUMBERS  * 

S  INDEXES  THE  HEX  SIDES  * 

i  IN  COUNTERCLOCKWISE  ORDER  * 

I NTEGER*4  HXS1DES( 2401 )  iPACKED  HEX  CONNECTIVITIES  * 
DIMENSION  XY(240l,2)  1  THE  XY  COORDINATES  OF  THE  * 

1  HEX  CENTERS  * 

COMMON  /HXSr0R/HXN,HXN0,S,HXS10ES,XY 
************************************************************ 
INCLUDE  'DISPLAY .CMN ' 

**********************************  ************************** 

*  XO  ANO  YO  ARE  THE  CENTER  COORDINATES  OF  THE  DISPLAY  * 
************************************************************* 

COMMON/DISPLAY/  xq,yo 

************************************************************* 

INCLUDE  'UTILlHEXROAD.OPN' 

*  THIS  OPENS  THE  ISAM  FILE  USED  TO  PROCESS  AND  * 

*  DISPLAY  THE  LJC  AND  HYDRO  DATA  .  * 

OPEN C UN IT=7,NAMfc='HEXK0AD',STATUS=' UNKNOWN', 
ORGANIZATIONS' INDEXED', ACCESS* 'KEYED ', RECL*2 , 

RECORD! YPE= 'FIXED', FORM* 'UNFORMATTED', 

KEYsC 1:4: INTEGER) , SHARED) 

LU  =  7 


♦ 

♦ 

* 


X0=XO-500O00 

YOsYO-5700000 

CALL  XYL2HA(X0,Y0,MINLEV,HEX0)  i  SET  CENTER  HEX 
DO  1=1, HXN  !  FOR  EACH  HEX 

HXNO(I)=HXADD(HXNO(I) ,HEXO)  1  TRANSLATE 
CALL  HEXREAD(HXNOd),  HX  SIDES  (  I  )  ,  LU  )  !  GET  SIDES 
CALL  HA2XYL(HXN0(I) ,X, Y,MINLEV)  i  GET  XY  COORDINATES 
XY(I,1)=X+50UQOO  I  BOTH  COORDINATE  SYSTEMS  ARE 
XY(I,2j=Y-*-5700000  I  CENTERED  AT  32UNC00 
ENDDO 
RETURN 
END 
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SUBROUT 1 NE  DRAWROADSUMIN.XHAX.YMIN.YMAX) 
********************************************************** 

*  THIS  SET  OF  ROUTINES  SUPERIMPOSES  ThF  BDM-  * 

*  DERIVED  RUAONET  On  THE  HEX  COnNEC 11 V  T , J  ES  FOR  ♦ 

*  COMPARISON.  * 

********************************************************** 

*  INPUTSlXMlN, ETC— BOUNDING  COORDINATES  IN  METERS  ♦ 

********  **********************************  **************** 

INTEGER*4  I.J.X.Y 
INCLUDE  'UTIL:LNKnOD.CMN' 

1  *************** ** ** ************************ ****** ***********4*** 

1  *  ARRAYS  FOR  THE  GRID, NODE. LINK. AND  SUBNODE  FILES  * 

1  **************************************************************** 

1  INTEGERM  GR ID , NODREC , LNK KEC , SUBKEC 

1  COMMON  /LNKNOO/GR1D(128,128),NODREC(5,100),LNKREC(5,100) 

1  ♦  , SUBREC ( 500 ) 

1  ***************************************************************** 
INCLUDE  'UT1L:LNKnOD.OPN* 

1  *  OPENING  THE  GRID , NODE , LI NK , AnD  SUBNODE  FILES 

1  OPEN (UNI Isl ,NAME= 'GRID' ,TYPE='0LD' .READONLY, 

1  * ACCESSs 'DIRECT' .BLOCKS I ZE=2000, SHARED) 

1  OPEN ( UNI T=2, NAMEs 'NODE' .TYPES 'OLD '.READONLY, 

1  * ACCESS* 'D IRECT '.BLOCK SI ZEs2000, SHARED) 

1  OPEN ( UNI T=3,NAMEs' ROAD ',TYPE= 'OLD', READONLY, 

1  * ACCESS* 'DIRECT' , BLOCK S I ZE =2000 .SHARED) 

1  OPEN (UN I T=4, NAMEs 'SUBN' .TYPEs 'OLD' .READONLY, 

1  * A CCESSs 'D IRECT ',BLOCKSIZEs2000, SHARED) 

1  * 


READ  IN  GRID  FILE 
CALL  GR1DR 
FOR  EACH  GRID 


DO  XsXMIN-luOOO.XMAX, 10000 

DISTANCES  ARE  MEASURED  IN  UNITS  UF  20  METERS  FROM 
AN  ORIGIN  OF  50000UM  N,  S600000M  E.  THE  ORIGIN 
CORRESPONDS  TO  GRID  INDICES  OF  (6S.65). 

DO  YsYMIN-10000, YMAX, 10000 
CALL  IGKlD( X.Y.l.J) 

CALL  OR*REC(GRID(I,J)) 

ENDDO 

ENDDO 

RETURN 

END 


i 

i 

i 

1 


B-34 


0001 
0002 
oon  i 

0004 

0005 

000b 

0007 

0008 

oooy 

0010 

0011 

0012 

0013 

0014 

001b 

0016 

0017 

0018 

0019 

0020 

0021 

0022 

0023 

0024 

0025 

002b 

0027 

0028 

002y 

0030 

0031 

0032 

0033 

0034 

0035 

003b 

0037 

0038 

0039 

0040 


SUBROUTINE  DR*(XX,YY , SIDES) 

************************************************************** 

*  Inputs:  * 

*  XX, YY — CENTER  DF  THE  HEX  TO  BE  DRAWN  * 

*  SIDES—  THE  COLOR  CODES  FOR  THE  HEX  * 

************************************************************** 

IMPLICIT  INTEGER  (H,P) 

INTEGER  SI OES ( 6  ) 

INCLUDE  'HXGRO.CMN' 

**************************************************** 

*  PARAMETERS  USED  IN  DRAWING  THE  HEXES  AND  * 

*  THE  LGC  DATA  * 

**************************************************** 

*  PI  3.14159  * 

*  X ,  Y  THE  RELATIVE  POSITIONS  OF  THE  HEX  * 

*  VERTICES  * 

*  RAD  RADIUS  IN  METERS  OF  A  HEX  * 

*  PHI  RELATIVE  ROTATION  TO  THE  START  OF  * 

*  1HE  HEX  DRAW; ie , THE  'BOTTOM'  * 

*  XPHI ,  THE  RELATIVE  DISTANCES  TO  THE  START  * 

*  YPH1  OF  THE  HEX  DRAW  * 

**************************************************** 

REAL  PI , PSI , PHI 

COMMON/HXGRD/XCb) ,Y(6) , RAD, PHI, PI, 

♦  XPHI , YPHI 

**************************************************** 

*  THIS  IS  THE  ORDER  IN  WHICH  THE  SIDES  ARE  DRAWN 
INTEGER  S ( 6 ) 

DATA  S/3, 1,5, 4, 6,2/ 

CALL  VECABS 
CALL  MOVE ( XX , Y Y) 

CALL  VECREL 

CALL  MQVE(XPHI,YPHI) 

DJ  J=l,b 

LTYP=SIDES(S(J)) 

CALL  LINCLH(LTYP) 

CALL  DRAW(X(J),Y(J)) 

ENDDO 

RETURN 

END 


0001 

SUBROUTINE  DRftGKD 

0002 

************************************************************** 

000  3 

* 

THIS  ROUTINE  DRAWS  THE  GRID  LINES  * 

0004 

************************************************************** 

000b 

INCLUDE  'GRAPH. CMN' 

OuOo 

1 

***********************.»****************************** 

0007 

1 

REAL  XMIN,XMAX, YMIN.YMAX  1  alNDOW  BOUNDARIES  * 

OOOU 

1 

l  IN  METERS  * 

0009 

1 

INTEGER  1  NT, LEV  1  INTERVAL  FOR  ACCESSING  THE  * 

0010 

1 

1  DATA  AND  LEVEL  DF  HEX  * 

0011 

1 

COMMON  /GRAPH/XMIN,XMAX,YKIN,YMAX,INT,LEV 

0012 

1 

**♦ ****************  **********  ****** ******************* 

0013 

CALL  CMDPEN 

0014 

CALL  BK 3CLR ( 7 ) 

001b 

CALL  ne*pag 

OOlb 

CALL  LINCLR(O) 

0017 

* 

DrAk  THE  HORIZONTAL  GRID  LINES  ^ 

OOlb 

Y1NT=1NT 

0019 

DO  Y=YM1N, YMAX, YINT 

0020 

CALL  MOVF.(XMIN,Y) 

0021 

CALL  DRAW ( XM AX . Y ) 

0022 

ENDUO 

0023 

* 

DRAM  THE  VERTICAL  GRID  LINES 

0024 

X I  N  T=  I N  T 

002b 

DO  X=XMIN,XMAX,XINT 

002b 

CALL  M0VE(X,YMIN) 

0027 

call  dra*»(x,ymax) 

002b 

ENDUO 

0029 

* 

PRINT  THE  LOWER  LEFT  COORDINATES 

0030 

CALL  CMCLUS 

0031 

CALL  MARKER 

0032 

RETURN 

0033 

END 
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PROGRAM  DR  WHEX 

************************************** '»**♦ 

*  A  Sc.  i  u  ROUTINES  TJ  DISPLAY  THE  ♦ 

*  LOC  AND  'HEXISED  LOC  DATA  AND  * 

*  TnE  ASSOCIATED  GRIDS.  * 

******************************************  j 

INCLUDE  'UTIL: HEX. CNN' 

1  *************************************************** 

1  *  FOR  DEFINITIONS  OF  VARIABLES  SEE  HXINIT.FDR 

1  ******************************************************************* 

1  IMPLICIT  INTEGEH(H#P) 

1  COMMON/HEX/IHaOUT ,NHL£V,MINLEV, SLTO ,CLT0,DLN0,DIAM(10),D1AMTR 

1  ♦  XOFI,YoFI,XOF J,YOFJ,RIOFX,RJOFX,RIOFY,RJOFY, 

1  *  ICON170) , J€0N(70) ,1MAX(7) , JMAX(7) 

1  ******************************************************************* 

INCLUDE  'hXSTOR.CMN' 

1  ************************************************************ 

1  *  THERE  ARE  2401  LEVEL  4  HEXES  IN  A  LEVEL  8  HEX  * 

1  INTEGERM  HXN0(2401)  i  THE  INTERNAL  HEX  NUMBERS  ♦ 

1  I  nTEGERM  S  ( 6 )  !  S  INDEXES  THE  HEX  SIDES  * 

1  J  IN  COUNTERCLOCKWISE  ORDER  ♦ 

1  INTEGERM  HXSIDES( 2401 )  ! PACKED  HEX  CONNECTIVITIES  * 

1  DIMENSION  XX (2401 ,  2 )  I  THE  XX  COORDINATES  OF  THE  * 

1  •  HEX  CENTERS  * 

1  COMMON  /HXSTOK/HXN,HXNO,S,HXS1D£S,XY 

1  ************************************************************ 

INCLUDE  'GRAPH. CMN' 

1  ****************************************************** 

1  REAL  XMIN,XMAX, YMIN,YMAX  J  WINDOW  BOUNDARIES  ♦ 

1  i  IN  METERS  * 

1  INTEGER  I  NT, LEV  »  INTERVAL  FOR  ACCESSING  THE  * 

1  »  DATA  AND  LEVEL  OF  HEX  * 

1  COMMON  /GRAPH/XMlN, XM  A  X , XMIN, XMAX, INT, LEV 

j  ****************************************************** 

INCLUDE  'TYPE. CMN' 

1  *************************************************** 

1  LOGICAL  LOC  I  TYPE*ROADS  * 

1  LOGICAL  HYDRO  1  TXPE=RIVERS  * 

1  common/txpe/loc, hydro 

1  *************************************************** 

CHARACTER*!  IANS 
PRINT*, 'LOC  OH  HYDRO?' 

R£AD( 5,10) IANS 
IF(1ANS.EU.'L')L0C=.TRUE. 

IEUANS.Ej.  'H') HYDRO=. TRUE. 

I F ( .NOT. LOC. AND. .NOT. HYDRD) THEN 
PRINT*, 'INVALID  TYPE?  TRY  AGAIN' 

STOP 

ENDIF 

IANSs'Y' 

DO  WHILE(IANS.EU.'Y') 

CALL  HXGRDINIT(LEV) 

CALL  GRIDIN  IT 

CALL  HEXGEN(HXN,HXNO,LEV,MINLEV) 

CALL  SETHXGRD(MlNbEV) 

CALL  DRWHXGRD 
IF(LOC)CALL  ORWROADS 


0058 

PRINT*,  'ROAoS?' 

0059 

R t A  D ( b , 1 0 ) I aNS 

0060 

10 

format ( i a i ) 

0061 

H (IANS.EU.'Y'JTHEN 

0062 

CALL  DkANROADS(X 

0063 

ENDlF 

0064 

CALL  FIXER 

0065 

PRINT*, 'ANOTHER  RUN 

0066 

RLAD(b, 10) IANS 

0067 

ENOOO 

0068 

CALL  GRSTOP 

0069 

END 

11  1 
12  1 


15  1 

16  1 
17  1 


21  1 
22  1 

23  1 

24  1 

25  1 

26 

27  1 
2b  l 

29  1 

30  1 

31  1 

32 

33  1 

34  1 

35  1 


38  1 

39  1 


***** 

* 


***** 


***** 

* 

* 

***** 

* 


***** 


***** 


***** 


***** 

***** 

* 


***** 


***** 


***** 


SUBROUTINE  ORwHXGkD 

****************************************** 

CALLS  'DRW'  T 3  DRAW  A  HEX  EITHER  IN  * 

BLACK  AND  WHITE  Or  I.U'NG  COLOR,  AS  * 

NEEDS  BE.  * 

******************* 

IMPLICIT  INTEGER! H ,  P ) 

INCLUDE  'HXGRO.CMN' 

*********************************************** 
PARAMETERS  USED  IN  DRAWING  THE  HEXES  AND  * 

THE  LOC  DATA  * 

*********************************************** 

PI  3.14159  * 

X,Y  THE  RELATIVE  POSITIONS  OF  THE  HEX  * 

VERTICES  * 

RAD  RADIUS  IN  METERS  OF  A  HEX  * 

PHI  RELATIVE  ROTATION  l’O  THE  START  OF  * 

THE  HEX  DRAW;ie,THE  'BOTTOM'  * 

XPH I ,  THE  RELATIVE  DISTANCES  TO  THE  START  * 

YPHI  OF  THE  HEX  DRAW  * 

*********************************************** 

REAL  PI , PSI , PHI 

C0MM0N/HXGRD/X(6) ,Y(6) , RAD, PHI, PI , 

♦  XPHI ,  YPHI 

*********************************************** 

INCLUDE  'UTILJUNPACK.CMN' 
************************************************* 

INTEGERS  HS1DE(6)  !  CONNECTIVITY  CODES  IN  * 

•  NUMERICAL  ORDER  BY  SIDE  * 

CJMMON/UNPACK/HSIDE 

************************************************* 

INCLUDE  'HXSTOR.CMN ' 

****************************************************** 

THERE  ARE  2401  LEVEL  4  HEXES  IN  A  LEVEL  8  HEX 
INTEGER*4*HXN0(24d1)  !  THE  INTERNAL  HEX  NUMBERS 
InTEGER*4  S(6)  l  S  INDEXES  THE  HEX  SIDES 

•  IN  COUNTERCLOCKWISE  ORDER 
INTEGER44  HXS1DES( 2401 )  IPACKED  HEX  CONNECTIVITIES 
DIMENSION  X Y ( 240 1 , 2 )  l  THE  XY  COORDINATES  OF  THE 

!  HEX  CENTERS 

COMMON  /HXSTOR/HXN,HXNO,S,HXSIDES,XY 

******************************************************* 
INCLUDE  'TYPE.CMN' 

********************************************** 

LOGICAL  LOC  1  TYPE=ROADS  * 

LOGICAL  HYDRO  I  TYPE=RI VERS  * 

COMMON /TYPE/LOC, HYDRO 

********************************************** 

CALL  CMOPEN 
IF  (LUC)THEN 
DO  J=1 , 6 
HSIDE(J)=0 
ENOOO 
ENDIF 

DO  lsl,HXN 

IF( HYDRO)  CALL  UNPACKER ( HXS1DES ( I ) ) 

CALL  DRW(XY(I,1),XYCI,2),HSIDE) 
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SUBROUTINE  DR«LNK2(X,¥.NXTLNK) 
******************************************************* 

*  THIS  ROUTINE  DRAWS  THE  'OUTLInK'  * 

*  ORIGINATING  A1  NODE  X,Y  AND  GETS  TH*-.  Pl)i  HER  * 

*  TO  THE  NEAT  LINK  AT  THIS  NODE  * 

******************************************************* 

*  inputs:  * 

*  A,Y~  COORDINATES  OF  THE  START  NODE  4 

*  NXTLNK--  THE  FIRST  OUTLINE  Ai  TriE  NODE  * 

4  OUTPUTS:  NXl'LNK  * 

******************************************************* 

INTEGER *4  TMPLI NK , SRECNUM , WRDPOS , NOD 
INTEGER42  ICLk,X,Y 
I NTEGER 42  NUM 
INCLUDE  #UT1L:SUB.C*N' 

********************************************************** 

*****  S JBX ,  SUBY  THE  X  AND  Y  COORDINATES  OF  THE  SUBNODES 
*****  Jh  ONE  LINK  (SEE  BDM  DOCUMENTATION) 

********************************************************** 

INTEGER*2  SUBXQOO)  .SUBYCIOO) 

CJHMON/SUb/  sjbx.suby 

********************************************************** 

INCLUDE  #UTIL:LNKNOD.CMN# 

**************************************************************** 

4  ARRAYS  FOR  THE  GRID , NODE , LI NK , AND  SUBNODE  FILES  4 

**************************************************************** 

INTEGER *4  GHID,NOdREC,LNKREC,SUBREC 

COMMON  /LNKnOD/GRID( 128, 128), N0DREC(5, 100), LNKREC (5, 100) 

♦  , SUBREC ( 5U0 ) 

***************************************************************** 
INCLUDE  * TY PE.CMN 0 

*************************************************** 

LOGICAL  LUC  !  TYPE=ROADS  4 

LOGICAL  HYDRO  1  TYPEsRlVERS  4 

COMMON/ TYPE/LOC, HYDRO 

*************************************************** 

CALL  CMDPEN 

CALL  GETNOX(NXTLNK,LRECNUM,«RDPOS) 

NswRDPOS 

LU=3 

CALL  GETR£C(LU,LR£CNUM, LNKREC) 

*  SET  LINK  TYPE  * 

TMPLlNKsLIBSEXTZV(0, 1 6 , LNKREC ( 3 , N ) ) 

CALL  LIB$INSV(TMPLINK,0,16,LTYPE) 

4 

IF( HYDRO) LTYPEsLTYPe-11 
4  NOT  ALL  TYPES  OF  LINKS  ARE  DRAWN  * 

IF(LTYPE.LE.3)THEN 

IF  ( LTYPE.LT. 0)LTY PE =-3 

ICLRsLTYPE+3 

CALL  LINCLK(ICLR) 

4 

4  SET  SUBNODE  PHYSICAL  RECORD  NUMBER  * 

rMPLINKsLiB$EXTZV(0,I6, LNKREC ( 5, N) ) 

CALL  LIB$INSV(TMPLINK,0, 16, SRECNUM) 

4  SET  SUbNODE  WORD  NUMBER  » 

rMPLINK=LiB$EXTZV(lb,16,LNKRECC5,N) ) 


0058 

0059  * 

0060  * 

0061  * 

0062 
0063 
0064 

0065  * 

0066 

0067  * 

0068 

0o6y 

0070 

0071 

0072  10 

0073 

0074 

0075 

0076 

0077 


CALL  LJ  8$lNSV(TMPLlNK,0,lb, NRDPUS) 


IF  TH£RE  ARE  MO  SUBMODES  SET  hXTLNK  AMD  RETURN  * 
XFtSRECNUM.GT.O. AND. rfRDPUS.GT.O) THEN 
CALL  GETSUB(SRECNJM, WRDPOS, NUN  ) 

CALL  MOVE(tRANX(X), TRANK*)) 

DO  1=1, NUM 

DRAN  TO  EACH  SUBNODE  * 

CALL  ORA*( TRANx(SUBX(I) ) ,TRANY(SUBX Cl) ) ) 
E.NDOO 

N0D=LNKkEC(4,N) 

CALL  ORnNOD(NJD) 

COM  1 INUE 
EN01F 
END  IF 

NXTLNK=LNKREC(2,N) 

CALL  CMCLOS 
RETURN 


i 


i 


i 


i 


i 


HEXER  CALLING  SEQUENCE 


HEXER 

I 

i - HEXINIT* 

- CORNERS 

- HEXGEN 

- HEX2XY* 

- UNGEN* 

i - GATOR 

- SUMMER 

- 1  CODE* 

- IELV 

- AVG 


♦TERRAIN  SYSTEM  UTILITIES 


Figure  B-7. 


PROGRAM:  HEXER 


1  SUbKOUTI N t  AVG(HXnO,X, Y ) 

0004  *  THIS  ROUTINE  AVERAGES  THE  ELF V  ATI  OHS , SLOPES , AND  CODES  * 

0004  *  FOR  ONE  HEX  A mD  NRITES  THE  ,  I  .  'I|,TS.  * 

000  b 

oooo  *  inputs:  hxnu —  external  fore,  uf  the  hex  number  * 

0007  ♦  X,Y  —  UTh  COORDINATES  OF  THE  HEX  CENTER  * 

000  b 

0009  IMPLICIT  INTEGFR*2  (H-P) 

0010  I  NTEGERM  HXNO 

0011  INCLUDE  'C3DE.CHN' 

0012  1  *************** **************************************************i 

0013  1  *  ICOL>  CONTAINS  THE  COUNTS  OF  THE  RESPECTIVE  SURFACE  CODES 

0014  1  *  COD  CONTAINS  THE  RESPECTIVE  PERCENTAGES 

0015  1  *  SSUM  IS  THE  SUM  OF  THE  ABSOLUTE  SLOPES 

0016  1  *  ZSUM  IS  THE  SUM  OF  THE  ELEVATIONS 

0017  1  *  NSLUPES  IS  THE  NUMbER  OF  SLOPES  COUNTED 

001b  1  *  AND  NPOINTS  IS  THE  NUMBER  OF  POINTS  COUNTED 

0019  1  ****************************************************************** 

0020  1  INTEGERS  IC0D(0:2) 

0021  1  DIMENSION  CQD(0:2) 

0022  1  COM MON /CODE /I COD , COD  , SSUM , ZSUM , NS LOPES , NPOI NTS 

0023  1  *************************************************************** 

0024  SsNSLOPES 

0025  S=S*1Q0.  !  DATA  BASE  RESOLUTION  UF  100M 

002b  SLHPE=SSUM/S 

0027  ELEVsZSUM/NPOlNTS 

002b  * 

0029  *  F JR  EACH  FEATURE  CODE 

0030  DO  1=0,2 

0031  *  COMPUTE  %  FEATURE  TYPE 

0032  COO(1)=ICOU( 1) 

0033  COO(i)=COD(I)/NP01NTS 

0034  *  NEXT  TYPE 

0035  ENDDO 

0036  LU=3 

0037  NR1TE(LU,11)HXN0,X, Y, SLOPE, ELEV, (COD(I) ,1=0,2), NPOINTS 

0038  ♦  , NSLOPES 

0039  11  F0RMAT(1X,I8,2F10.0,5F8.2,2I5) 

0040  RETURN 

0041  END 
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F UNCTION  bETWE£n(X,X1,X2) 

A  ROUTINE  xHICH  JUST  DETERMINES 
WHETHER  OR  nOT  X  IS  Bt-TWEEN  XI  AND  X2. 

INPUTS:  X,X1,X2--UTm  coordinate  values 
OUTPUTS:  aETWtEN--  A  LOGICAL  TRUE  OR  FALSE 
fl.B.  ♦♦♦SINCE  X  IS  REAL  AND  XI  AND  X2  ARE 

♦♦♦INTEGER,  CLOSE  CALLS  KAY  BF  UNRELIABLE 

INTEGER  XI, X2 
LOGICAL  BETWEEN 

TFtlXl-XI.ST.O.OR. ( X-X2) .GT.OJTHEN 
BET wEENs. FALSE. 

ELSE 

BETwEENs.TRUE. 

EnDI  F 

RETURN 

End 
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5 1‘ '  f  'TINE  CORNERS 
**♦*****.***♦.»( 

*  THIS  rsOUTI Nfc.  SETS  THE  C00RD1 NATES  OF 

*  THF  TERRAIN  BOX  BE  I nG  PROCESSED. 


THE  CORNERS  OF 


INCLUDE  'MAXMIN.CNN' 

1 

1  *  THE  UTM  LIMITS  OF  THE  RECTANGLE  OF  INTEREST  * 

1  ************************************************************ 

1  INTEGER  XMIN,XMAX, YMIN, YMAX 

1  COMMON  /MAXM1N/XM1N,XMAX, YMIN, YMAX 

1  ************************************************************ 
PRINT* ,  'ENTER  THE  SOUTHWEST  COORDINATES  IN  METERS:' 
PRINT*,  'EAS1ING:' 

READ( 5 , *) XMI N 
PRINT*, 'NORTHING: ' 

READ(5,*)*MIN 

PRINT* , 'NON  ENTER  THE  NORTHWEST  COORDINATES;' 

PRINT*, 'EASTING: ' 

R£AD( b , * ) XMAX 
PRINT*, 'NORTHINGS ' 

READ ( b  ,  * ) Y  M aX 

NOW  EXPAND  THE  BOUNDARY  SO  THAT  HEXES  WHICH  INTERSECT 
BUT  ARE  NOT  CENTERED  IN  THE  AREA  OF  INTEREST  wlLL  BE 
PROCESSED. 

•ROUGHLY  THE  RADIUS  OF  A  LEVEL  6 


C... 

C... 

C... 


XMIN=aMIN-1 25u0 

XMAA=XMAX*125oO 

YMINSYM1N-125U0 

YMAXSYMAX+12500 

RETURN 

END 


HEX 


***** 


lb  1 

17  1 

18  1 
19  1 


***** 


***** 


***** 

* 

* 

***** 


***** 


24  1 
2b 

2o  1 

27  1 

28  1 

29  1 

30  1 

31  1 

32  1 
1 

34  1 
3b  1 
3b  1 
37  1 


***** 


***** 


***** 

* 


SJFiRUUTiNE  GA10kCX,Y  ,HXan) 

****************************************************** 

(THIS  IS  THE  AGGRE'GAIOK'  )  * 

THIS  N (J U T 1  N fc  IS  DESIGNED  TO  AGGREGATE  * 

HEX  DATA  FROM  A  VtkSIJN  OF  THE  * 

TERRAIN  DISPLAY  FILE.  * 

****************************************************** 
inputs:  x,y--  coordinates  of  the  cehter  of  the  * 

HEX  (  IN  METERS  from  hex  ORIGIN)  * 

HXNJ--  EXTERNAL  HEX  NUMBER  * 

****************************************************** 

IMPLICIT  INTEGERS  (H-P) 

I NTEGER *4  HXN0,INTX,INTY,1X,IY 
include  'corner. Cmn' 

***************************************************** 

S*X,SrfY  ARE  THE  SOUTHWEST  UTM  COORDINATES  OF  THE  * 

AREA  REPRESENTED  BY  THE  DATA  IN  IBUF.  * 

***************************************************** 

1 HTKGER  *4  S*X,S*Y 
COM MON/ CORNER /S*X,SrfY 

**************************************************** 

INCLUDE  'HEXRAD.CMN' 

integers  dbres,hexr 

COMMON /HEXR AD / DBR£S, R AD2, HEXR 
INCLUDE  'CODE.CMN' 

************************************************************** 

1  COD  CONTAINS  THE  COUNTS  OF  THE  RESPECTIVE  SURFACE  CODES  * 
CJO  CONTAINS  THE  RESPECTIVE  PERCENTAGES  * 

S5UM  IS  TriE  SUM  OF  THE  ABSOLUTE  SLOPES  * 

ZSUM  IS  THE  SUM  OF  THE  ELEVATIONS  * 

NSLOPES  IS  THE  NUMBER  OF  SLOPES  COUNTED  * 

AND  NPOINTS  IS  THE  NUMBER  OF  POINTS  COUNTED  * 

************************************************************** 
INTEGER*2  IC0UCOJ2) 

DIMENSION  CUDC0S2) 

COMMO,N/CODE/ICOD,CDD,SSUM,ZSUM,NSLDPES,N  POINTS 

********************************************************** 

NSLOPES=0 
NPOINTSsO 
ZSUm=0 
SSUM=0 
DO  1=0,2 

ICOD( I)=0 
ENODO 

F JR  EACH  N-S  SCAN  LINE  INTERSECTING  THE  CIRCLE 

INTX=NlNT(X/DbRES)*DBRES 
INTY=NINTI Y/D«RER)*OBRES 

DO  IX=INTX-HEXR,lNTX+HEXR,DbRES 

YDELTA=NINTCS0RrCRAD2-(IX-INrX)*42)/DBRES)*DBRES 
Y DELTA  IS  THE  DISTANCE  (ROUNDED  TO  DBRES) TO  THE 
CIRCUMFERENCE 

FOR  EACH  POINT  ON  THE  SCAN  LINE, FROM  S  TO  N 
DO  IY=INTY“ Y DELTA, INTY+YDELTA, DBRES 
J=(IX-SwX)/DBRES+l 


GATUk 


005b 

005* 

0060 

0061  ♦ 

0062 

0063  * 

0064  ♦ 

0065 
0066 
006  / 


ls(lY-SWY)/DHkt'S+l 
CALL,  SUM^EM  i  ,J) 

ENDD3 

NEXT  POINT 
ENDUO 
NEXT  SCAN 
NEXT  HEX# 

IF(NP3INTS.nE.0)CALL  A VG ( HXnO , X , Y ) 
RETURN 
END 


0001 

0002 

0003 

0004 

000b 

000b 

0007 

OOOb 

0009 

0010 

0011 

0012 

0013 

0014 

001b 

001b 

0017 

0010 

0019 

0020 

0021 

0022 

0023 

0024 

002b 

002b 

0027 

0020 

0029 

0030 

0031 

0032 

0033 

0034 

003b 

003b 

0037 

0038 

0039 

0040 

0041 

0042 


PROGRAM  HEXER 

*************] 

'  HEX  1 SES '  THE  SURFACE  AND  ELEVATION  DATA 

I********************* 

IMPLICIT  INTEGER(H,P) 

LOGICAL*  1  BRTrfFErt 
INCLUDE  'MAaMIN.Cvn' 

********************! 

*  THE  UTM  LIMITS  OF  THE  RECTANGLE  OF  INTEREST  * 

************************************************************ 
INTEGER  XMIn,XMAX,YMIN, YMAX 
COMMON  /MAXMlN/AMlN,XMAX,yMIN,YKAX 
************************************************************ 


include  'corner. cmn' 

1  ********************************************************** 

1  *  Sm X , Sn Y  ARE  THE  SOUTHWEST  UTM  COORDINATES  OF  THE  * 

1  *  AREA  REPRESENTED  BY  THE  DATA  IN  IbUF.  * 

t  ********************************************************** 

1  INTEGERS  SrtX,SMY 

1  CUMMON/CORNER/SrfX,S*Y 

1  ********************************************************* 
DIMENSION  HEXo(2401 J ,HEX4(49) 

CALL  HEX IN IT 
CALL  CORNERS 

CALL  HEXGEN(HA6,HEXb,10,b)  ! GET  ALL  LEVEL  6  CENTERS 
CALb  HF.XGEN(HX4,HEX4,b,4)  1  GET  CENTER  LEVEL  b 

DO  1=1, HXo 

CALL  HEX2XY(riEX6(I) ,X, Y) 

IF ( BETWEEN (X,XMlN,XM AX) .AND. BETWEEN ( Y, YMIN,  Y MAX)  ) THEN 
S*X=NINT(X/10000. ) *10000-20000 
SW Y=HINT(Y/1 0000. ) *10000-20000 
CALL  UNGEN 
DO  J= 1 , HX  4 

HEX=HXADD(HEX6(I) , HEX4 ( J ) ) 

CALL  HEX2XY(HEX,X, Y) 

CALL  HEXOUTCHEX, 1 ,H) 

CALL  GA TOR ( X  ,  Y  ,  H  ) 

ENDDO 

ENDIF 

ENDDO 

PRINT*, 'TH-TH-THATS  ALL  F-FOLKS.' 

END 


i 
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3002 
300  J 
3004 
300b 
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0012 
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0014 
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002b  C 
0026 
0027 
0028 
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0031 
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0055 
0056 
0057 


SUBROUTINE  HEAGEN(HXN,HXND,LEVTl)P,LKk  uOT) 

*************** ************ ************ ************************* 

*  THIS  ROUTINE  GENERATES  HEX  NUMBtf-'S  * 

*  FROM  LEVEL  'LtVTOp'  TU  ' LE VuDT ' ,  * 

*  NESTED  IN  HtX  FASHION.  * 

**************************************************************** 

*  INPUTS:  LEV10P,LEVB0T—  THE  TUP  AND  BOTTOM  LEVELS  * 

*  OF  THt  HEX  TREE  TO  bE  GENERATED  * 

*  OUTPUTS:  HXN—  THE  NUMbER  OF  HEXES  GENERATED  * 

*  HXNJ—  THE  ARRAY  CONTAINING  THE  HEX  NUMBERS  * 
**************************************************************** 

IMPLICIT  INTEGER  (H,P) 

DIMENSION  LEVST0P(4:1(>) 

DIMENSION  HXN0(240l) 

INTEGER *4  ZERO 

C..  THE  VARIABLE  'LEVMIN'  SHOULD  bE  (AND  PROBABLY  IS)  SET  ELSEWi 

LEVMIN=4 
ZERO=77777777 
L=LEVrOP-LEVBJT 
IF(L.EO.O) THEN 

PRINT#, 'ERROR  IN  HEXGEN ' 

RETURN 


ENDIF 

H aN  =  7  ** ( L-l )  J  YOU  MUST  ASK  FOR  AT  LEAST  ONE  LEVEL 
D  PRINT*, 'HXN', HXN 

DO  1=4,10 

LE VSTOPC I ) =0 
ENDDO 

DJ  I=LEVRJT,LEVT0P-1 
LEVST0P(I)=6 
ENDDO 
H  AN  =  0 

C...  IF  LEVST0P(LEVEL)=0  THE  LOOP  IS  ONLY  EXECUTED  OnCE,  AND 
C...  THE  DIGIT  SUBTRACTED  IS  0,..NO  CHANGE 

DO  LEV10=0,LEVSTOP( 10) 

LI 0=LE V 1 0*1 000000 
DO  LEV9=U,LEVST0P(9) 

L9=LEV9*1 00000 
DO  LEVB=0,LEVST0P(8) 

L8=LEV8* 10000 
DO  LEV7=0,LEV5T0P(7) 

L7=LEV7*1000 
UO  LEV6=0,LEVSTOP(6) 

L6=LEV6* 1 00 
DO  LEV5=0,LEVSTUP(5) 

L5=10*LEV5 

DO  LEV4=0,LEVSTOP(4) 

L4=L£V 4 
HXNsHXN+1 

HXNO(HXN)=ZERO-L10-L9-L8-L7-L6-L5-L4 
D  PRINT*, HXN, HXNO(HXN) 

ENDDO 

ENDDO 

ENDDO 

ENDDO 

FNDDO 

ENDDO 
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HEXGEu 


005b 

E 

oosy  c  o 

PKIimT*  , 

0060 

DJ  Nsl, 

0061 

CALL 

0062 

HXnO 

0063 

ENDOO 

0064 

RETURN 

0066 

END 
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SUBROUTINE  SUMMEH(1,J)  f 

*  SJMS  f HE  ELEVATION, SLOPE, AND  FEATURE  DATA  Al  ONE  t.-ii  r  * 

*  INPUTS:  1,J~  THE  ROW  AND  COLUMN  IN  THE  ARRAY  1BUF  *  j 

IMPLICIT  INTEGERS  (H-P)  * 

INCLUDE  'hEXRAD.CMN' 

1  INTEGERS  DriRES,HtXR  ; 

1  CU*M0n/H£XRAD/DBRES,RAD2,HEXR 

INCLUDE  'CODE.CMN'  -J 

1  ******************************************************************* ^ 

1  *  TCno  CONTAINS  THE  COUNTS  OF  THE  RESPECTIVE  SURFACE  CODES  ** 


CJO  CONTAINS  THE  RESPECTIVE  PERCENTAGES  * 

ssim  is  the  sum  of  the  absolute  slopes  *; 

zsuri  is  thf  sum  of  the.  elevations  .  *  ; 

N SLOPES  IS  THE  NUMBER  OF  SLOPES  COUNTED  *  ■'. 


*  AND  NPOINTS  IS  THE  NUMBER  OF  POINTS  COUNTED  * 

******************************************************************* 

I NTEGER*2  I  COD ( 0 : 2 ) 

DIMENSION  CUD (0:2) 

CDMMON/CODE/ICOO,COD,SSUM,ZSUM,NSLOPESr NPOINTS 
*************************************************************** 

C...  COMPUTE  THE  ABSOLUTE  DIFFERENCE  IN 
C...  ELEVATIONS  BETWEEN  THIS  POINT  AND  THE 

C...  POINTS  ADJACENT  TO  THE  N  AND  E 

C...  ADD  TO  THE  CUMULATIVE  SUMS  UF  DIFFERENCES  J 

C...  AwD  ELEVATIONS, RESPECTIVELY 

Z1  =  1F.LV(1,  J) 

IF CZ1 .LE.0.UR.Z1. GE.4000) RETURN 
C...  INCREASE  THE  POINT  COUNT 

NPOlNrS=NpOlNTS*l 
C 

C...  INCREASE  THE  FEATURE  CODE  TALLIES 

ICslCODECl, J) 

IFC1C.NE.1.AND.1C.NE.2)  IC=U 
IC0D(IC)=ICUD(IC)+1 
C 

ZSUn=ZSUM+Zl 

IF(J+1.GT.400)GUTU30  1400  COLUMNS 

Z2=IEL V ( 1 , J+l  ) 

IF(Z2.LE.0.OR,Z2.GE.40O0)G3TO30 
NSLUPESsNSLOPES+1 
SSUMsSSUM*ABS(Zl-Z2) 

30  CONTINUE 

IFU  +  1  .GT.4U0 JRETURN  1400  ROWS  IN 
Z3  =  1F.LV(1*1  ,  J  ) 

IF ( Z3.LE.0. OR. Z3. GE.4000) RETURN 
NSL0P£S=NSLUPES+1 
SSUM=SSUM*ABSCZ1-Z3) 

RETURN 
END 


IN  THE  ARRAY 


THE  ARRAY 
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HYDROHEXER  CALLING  SEQUENCE 


HYDROHEXER 

I 

; - HEXINIT* 

- OPENERS 

- GRIDR* 

- NODEHEX 

- GETNDX* 

- GETREC 

- LINKHEX 

l 

' - GETNDX* 

- GETREC* 

- GETSUB* 

- TRANX* 

■ - TRANY* 

* - HEXSIDE 

‘ - HXRECORD 

- HEXREAD* 

- PACKER* 


♦TERRAIN  SYSTEM  UTILITIES 
Figure  B-9. 
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SUBROUTINE  HEXSIDL(X,Y,H6,HN,m,Z) 
********************************************************** 

THIS  SUaRDUTINE  Dr.1  c,a  ■  .  «ES  THE  HEX  NUMBER 
THAT  AN  I  X,Y  COOkuI  N  A  1 1  t»  LIES  WITHIN.  THEN 
IT  DETERMINES  THE  SIDE  OF  THE  HEX  THAT  IS 
NEAREST  THE  COORDINATE. 

********************************************************** 

INPUTS: 

X,T —  EASTING, NORTHING  IN  METERS 
OUTPUTS: 

t*S~  HEX  SIDE 
HN—  HEX  NUMBER 

N,Z  —  COORDINATES  OF  CENTER  OF  HEX  IN 
METERS  FROM  CENTER  OF  HEX  ORIGIN 
********************************************************** 
ATshORIZONTAL  DISTANCE  OF  THE  POINT  FROM  THE 
HEX  CENTER. 

BTsVERTiCAL  DISTANCE  OF  THE  POINT  FROM  THE 
HEX  CENTER. 

A  AND  8  AkE  THE  COORDINATES  OF  THE  POINT  RELATIVE 
TO  A  ROTATION  OF  THE  COORDINATE  SYSTEM. 

C*THE  COSINE  OF  THE  ANGLE  OF  ROTATION. 

SsTHE  SINE  OF  THE  ANGLE  OF  ROTATION. 
D*TAN(60)*A=SURT(3)*A 

THE  SIDE  OF  THE  HEX  THE  POINT  IS  NEAREST  CAN 
BE  DETERMINED  BY  ITS  ANGLE  FROM  THE  HORIZONTAL 
AXIS. 

•SIDE3:0-60  S1DE1:60-120  SIDE5: 120-180 

SIDE4 : 1 80-240  SlOEb : 240-300  SIDE2 : 300-3b0 
THE  POINT  IS  WITHIN  60  DEGREES  OF  THE 
HORIZONTAL  AXIS  IF  A8S(B/AXTAN(60)sSORT(3) . 
THEREFORE: 

IF  i)<b<D,  THEN  0-60  DEGREES. 

TF  u<b<-0,  THEN  120-180  DEGREES. 

IF  0<B  ANQ  NEITHER  OF  ABOVE,  THEN  60-120  DEGREES. 

IF  D<8<0 ,  THEN  180-240  DEGREES. 

IF  -D<8<0,  THEN  300-360  DEGREES. 

IF  8<0  AND  NEITHER  OF  ABOVE,  THEN  240-300  DEGREES. 
********************************************************** 
IMPLICIT  INTEGER  (H,P) 

INCLUDE  'TRAN.CMN' 

COMMON/ TR AN/S, C,L,SQ3 
CALL  XYL2HA(X, Y,L,HN) 

CALL  HA2XYL(HN,W,Z,L) 

AT=X-W 
BT=Y-Z 
A=C»AT+S*BT 
B=C*BT-S* AT 
D*SQ3*A 

IF(B.GE.O)  THEN 
IF(B.LE.U)  THEN 
HS=3 

ELSE  IFCB.LE.-D)  THEN 
H  S= 5 
ELSE 
HS=  1 
END  IF 
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SOHKOim.lt  HX RECORD (Ha, HSIDE, lEkR) 

*****************************************.. 

*  RECORDS  THE  HYDRO  CODE  'LTYPE'  AT  SIDE  'HSIDE'  3F  * 

*  TnF.  HEX  'HA'.  THEN  II  FINDS  THE  ADJACENT  HEX  AND  * 

*  the  Corresponding  side  and  ke-recuros  the  info.  * 

************************************************************ 

*  INPUT:  HA  — THE  HEX  ADDRESS  OF  1  HE  FIRST  SUbNQDE  ♦ 

*  HSIDE—  THE  SIDE  OF  HEX  'HA'  AT  WHICH  THE  * 

*  HYDRO  CODE  IS  BEING  RECORDED  * 

*  OUTPUT:  1ERR--  AN  ERROR  FLAG  * 

************************************************************ 

IMPLICIT  INTEGERS, P) 
include  'util:pack.cmn' 

********************************************************** 

I N  f tGER*4  SIDES  1  PACKED  CONNECTIVITIES  * 

1NTEGERM  LIT  PE  l  CONNECTIVITY  FOR  CURRENT  SIDE  ♦ 
COMHOn/ PACK/S IDES, LTV PE 

********************************************************** 

LJ=7  !  LOGICAL  UNIT  FOR  HEX  FILE 

*  PUT  THE  SIDE  INDICATOR  INTO  INTERNAL  HEX  FORMAT 
CALL  HEXlN (HSIDE, i,4,HST0RA) 

*  FIND  THE  ADJACENT  HEX  BY  ADDITION 
H3=HXADD(HA,HST0RA) 

*  find  THE  INVERSE  OF  THE  SIDE 
HSTURb=HXINV(HSTORA) 

* 

*  GET  THE  RECORD  FOR  HEX  'HA'  OR  CAUSE  IT  TO 

*  BE  INITIALIZED  IF  NECESSARY 
CALL  HEXR£AD(HA, SIDES, LD) 

* 

CALL  PACKER(HA,HSTORA,LO,1ERR) 

IF  (1£RK.E0*0) RETURN 

* 

*  NOW  FOR  THE  SECOND  HEX 

CALL  HEXREAD ( HB, SIDES , LU ) 

CALL  PACKER ( Hd, KSTORB , LU , IERR ) 

RETURN 

END 
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PROGRAM  H  YDHOHEXR 

**************************************************** 

*  THF  SET  OF  ROUTINES  USED  TO  'HEXISE'  THE  * 

*  BDM-PKODUCEO  GERMAN  hydrography  data.  * 

******♦**♦*♦*♦*♦♦  ********»****4¥»******************* 

IMPLIC11  1NTEGEK(H,P) 

InTEGER*4  XO ,  Y  0 
INCLUDE  'TRAN.CMN' 

COMMON/ TR AN/S, C,L,Sj3 
INCLUDE  'UTILlLNKNOD.CMN' 

**************************************************************** 

*  ARRAYS  FOR  THE  GRID, NODE, LINK, AND  SUBNOOE  FILES  * 

*********4******* **********?*** *************  ******************** 

1  NTEGER44  GHlD,NODREC,LNKREC,SUbREC 

COMMON  /LNKNOu/G»lD( 12B, 128) ,NDURECC5, 100) ,LNRR£CC5, 100) 

♦  , SUBREC 1500) 

***************************************************************** 

INCLUDE  'UTlLlCENTER.CMN' 

********************************************************** 

*  THE  CENTER  OF  THE  HEX  GRID  IS  AT  XORIGIN , YOkIGIN  * 

*  MHERE  THE  COORDINATES  ARE  IN  METERS  UTM  RELATIVE  * 

4  TO  A  GIVEN  GRID  ZONE.  * 

********************************************************** 

I NTeGER*4  XORIGIN, YORIGIN 
COMMON/CEHTER/XURIGIN, Y0R1G1N 
DATA  XORIGIN/ 500000/, Y0RIGIN/5700000/ 
********************************************************** 

*  INITIALIZE  THE  HEX  PARAMETERS 
CALL  HEXlNlT 

*  OPEN  THE  uOC  AND  HEX  FILES  4 

*  INITIALIZING  VARIABLES  FOR  USE  IN  HEXSIDE  4 

SJ3=SORT(3.) 

REALEV=LEVMIN 

AnGKADs REA LEV419. 1143.14159/180. 

S-SIN ( A  NGR AD ) 

C-COS( ANGR AD ) 

L=4 

4  READ  IN  THE  GRID  POINTERS 

CALL  GRIDK 
DO  J=1,12B 
DO  1=1,128 

NODEsGRIDU,  0) 

IF (MODE.NE.O)CALL  NODEHEX ( NODE) 

ENODO 

ENDDO 

* 

END 


SUBROUTINE  LINKHEX(NOuX ,NOD* ,LNKNUM) 

THIS  KujTj’.’t  PROCESSES  UHL  'OUTLI NK  '  ,  * 

CAUSING  EACH  SUBNJDE  TO  RE  RECOkDED  AS  A  * 

HYDRO  CODE  AT  THE  CLOSEST  SIDE  OF  THE  HEX  * 

WHICH  CONTAINS  THAT  SUBNODE.  ♦ 

******************************************************* 
INPUT:  ♦ 

LNKNUM--THE  LINK  NUMBER  OF  THE  FIRST  ♦ 

LINK  INCIDENT  TO  THIS  NODE  * 

s  NODX,NODY--  EASTING, NORTHING  IN  METERS  * 

OF  THE  START  NODE  * 


******************************************************** 

IMPLICIT  INTEGER  (H,P) 

INTEGER *2  TMPLINK,TERMX,TERMY,NODX,NODY 
jnteger*2  X(0:iooj,yco:1oo) 

I NTEGERM  WHDPOS , SRECNUM , SUBWRD , TER MX Y 

include  'utilisub.cmn' 

*********************************************************** 

*  SORX , SUBY  THE  X  AND  Y  COORDINATES  OF  THE  SUBNODES  * 

*  IN  ONE  LINK  (SEE  BDM  DOCUMENTATION)  * 

*********************************************************** 

INTEGERS  SUBX(IOO)  ,SUBY(100) 

COMMUN/SUb/  SUBX,SUBY 

********************************************************** 

INCLUDE  'UTILlPACK.CMN' 

********************************************************** 

1 NTEGERM  SIDES  !  PACKED  CONNECTIVITIES  * 

InTEGeRM  LTYPE  !  CONNECTIVITY  FOR  CURRENT  SIDE  ♦ 

COMMON /PACK /SIDES, LTYPE 

***************************************************  ****** 

INCLUDE  #UTIL:LNKNOD.CMNr 

**************************************************************** 

*  ARRAYS  FOR  THE  GRID , NODE , LINK , AND  SUBNODE  FILES  * 

**************************************************************** 

INTEGERM  GRID,  NODREC,  LNKREC , SUBREC 

COMMON  /LN K NOD/GRID ( 128,128), NODREC (5,100),LNKREC(5,100) 

*  ,SUBREC(500) 

***************************************************************** 
INCLUDE  'UTlL:CENTER.CMNr 

********************************************************** 

*  THE  CENTER  OF  THE  HEX  GRID  IS  AT  XORIGIN , YORlGI N  * 

*  WHERE  THE  COORDINATES  ARE  IN  METERS  UTM  RELATIVE  * 

*  TO  A  GIVEN  GRID  ZONE.  * 

********************************************************** 

INTEGERM  XORIGIN, YORIGIN 
C JMMON/CENTER /XORIGIN, YORlGI N 
DATA  XORIGIN/500000/, YORIGIN/ 5700000/ 
********************************************************** 

* 

X(0)=NODX 
Y ( 0 ) sNOOY 
NXTLNKsLNKNUM 
LU=3 

00  WHILE(NXTLNK.NE.O) 

CALL  GETNOX(NXTLNK,LRECNUM,WRDPOS) 

CALL  GETREC(LU,LRECNUM, LNKREC) 


005b 

* 

SEr  THE  TYPE 

0059 

NsaKDPJS 

0060 

4 

0061 

4 

SET  LINK  TYPE  * 

0062 

TMPL1NKsLIB$EXTZV(0, lb,LNKREC(3,N) ) 

006i 

CALL  LIbSINSV (TMPL1NK,0, l6,LTYPE) 

0064 

* 

0065 

LTYPE=15-LTYPE 

0066 

IF( LTYPE.LT. O.OR.LfYPE.Gf .3 )LTYPE=0 

0067 

* 

EXTRACT  THE  TERMINAL  COORDINATES  * 

0068 

TERMXYsLNKREC(4,WRDP0S) 

0069 

* 

THE  X  . 

0070 

TMP=LIBSEXTZV(0, 16, TERMX Y) 

0071 

CALL  L1B$INSV( TMP,U, 16, TERMX) 

0072 

* 

.  AND  THEN  THE  Y  * 

0073 

TMP=LIB$EXTZV (16,16, TERMX Y ) 

0074 

CALL  LIB$INSV(TMP,0, 16,TERMY) 

0075 

* 

0076 

* 

SET  SUBNODE  RECORD  POINTER  * 

0077 

TMPLINKsLlB$EXTZV(0,lb, LNKREC ( 5 , N ) ) 

0078 

CALL  LIB$1NSV(TMPLINK,0, lb,SRECNUM) 

0079 

* 

SET  SUBNODE  WORD  POINTER  * 

0080 

TMPLINK=LIB$EXTZV(16,16,LNKREC(5,N)) 

0081 

CALL  L1B$1NSV(TMPLINK,0, lb,SUBMRD) 

0082 

4 

0083 

4 

IF  THERE  ARE  SUBNODES  * 

0084 

IF(SRECNUM.NE.O) THEN 

0085 

4 

get  the  subnode  list 

0086 

CALL  GETSUB(SKECNUM,SUBWRD,NUM) 

0087 

* 

PROCESS  THE  SUBNODE  LIST  * 

0088 

DO  1=1, NUM 

0089 

X(I)=SUBX(I) 

0090 

Y ( 1 ) sSUBY ( I ) 

0091 

ENDDO 

0092 

X(NUM+l)sTEKMX 

0093 

Y(NUM+1 JsTEKMY 

0094 

DO  I=0,NUM4l 

0095 

XI =TRANX (X(IJ)-XORIGIN 

0096 

YlsTRANYt Y(I) J-Y0R1GIN 

0097 

CALL  HEXSIDE(X1,Y1,HS,HN,W,Z) 

0098 

CALL  HXRECORD(HN,HS,IADJ) 

0099 

ENDDO 

0100 

ENUIF 

0101 

4 

GET  THE  NEXT  LINK  RECORD 

0102 

NXTLNKsLNKKEC(2,MKDP0S) 

0103 

ENDDO 

0104 

RETURN 

0105 

END 

SUBROUTINE  NO0EHEX(nOO'  ) 

♦I****************************** ************* 

*  THIS  ROUTINE  EXTRACTS  THE  1*4  WORD  * 

*  WHICH  CONTAINS  THE  NODE  CORDInATES  * 

*  AND  THE  RECORD  *  OF  THE  FIRST  LINK  * 

*  WHICH  IS  INCIDENT  TO  THE  NODE  * 

*********************************4*********** 

*  InPUT:  NODE--  THE  HEAD  NODE  FOR  A  * 

*  GRID  RECORD  FROM  THE  * 

*  LOC  DATA  BASE  * 

********************************************* 

IMPL1CII  INTEGER  (H,P) 

INTEGERM  WRDPOS,TMp 
INTEGERS  NODX ,  NOD  Y 
INCLUDE  'UTILiLNKNOD.CHN' 

**************************************************************** 

*  ARRAYS  FOR  THE  GRID, NUDE, LINK, AND  SUBNOUE  FILES  ♦ 

**************************************************************** 

INTEGER *4  GRID, NODR EC , LNKREC , SUBREC 

COMMON  /LNKNOD/GRID(128, 128) , NODREC ( 5 , 1 00 ) , LNKREC( 5 , 1 00 ) 

+  ,  SUBREC 1500 ) 

***************************************************************** 
INCLUDE  'UTILSSUB.CMN' 

*********************************************************** 

*  SUBX,SU8Y  THE  X  AND  Y  COORDINATES  OF  THE  SUBNODES  * 

*  In  ONE  LINK  (SEE  BDM  DOCUMENTATION)  * 

*********************************************************** 

INTEGERS  SUBX(IOO)  ,SUBY(100) 

CO*«MON/SUi)/  SUBX ,  SUBY 

********************************************************** 

DO  WHILE  ( NODE . NE . 0 ) 

CALL  GETNDX(NODE,NRECNUM,WRDPOS) 

LU  =  2 

CALL  GETRECCLU,NRECNUM, NODREC) 

* 

N0DXYsn0DRECC5,WRDP0S) 

*  SET  THE  X  COORDINATE  * 

TMP=LIB$EXTZV(0, 16,N0DXY) 

CALL  LIBSINSV(TMP, 0,16, NODX) 

*  SET  THE  Y  COORDINATE  * 

TMP=LIB$EXTZV(16, lo,NODXY) 

CALL  LIB$INSVCTMP,U,16,N0DY) 

* 

LNK=N0DREC(4,WRDPQS) 

CALL  LINKHEXCNODX, NODY,LNK) 

♦  GET  NEXT  NODE 

NODEsNODHECd  ,WRDP05) 

ENDDO 

RETURN 


SUBROUTINE  OPENERS 

********************************************************* 

*  THIS  R0UT1  Nt,  SIMPLY  OPENS  IhE  GRID, NODE, LINK, AND  * 

*  SUBNODE  FILES,  AND  THE  ISAM  FILE  *HICH  CONTAINS  * 

*  THE  'HEXISED'  LOC  OK  HYDRO  DATA  * 

********************************************************* 

JPEM(UNIT=1 , NAMEs 'GRID', TYPES 'ULD' , READONLY, SHARED 
♦ACCESSs 'DIRECT' , BLOCKS I ZE=2000 ) 

OPEN ( UNI T=2, NAMEs 'NODE', TYPEs 'OLD '.READONLY, SHARED 
*ACC£SSs'DlRECr',BLOCKSIZEs2000) 

OPEN ( UN I T=3, N AMEs ' RO AD ',1YPE= 'OLD '.READONLY, SHARED 

♦  ACCESSs 'DIRECT '.BLOCK  SI ZEs2000) 

OPEN (UNI T*4, N AMEs ' SURN ' , TYPEs 'OLD', READONLY, SHARED 

♦  ACCESSs 'DIRECT' , BLOCKS  I ZEs2 000 ) 

* 

♦  NOW  FOR  THE  ISAM  FILE 

OPEN ( UN 1Ts7, N AM Es 'HEX RO AD ', ST ATUSs' UNKNOWN', 

+  ORG  AN  17.  ATI  Ons' INDEX  ED '.ACCESSs 'KEYED  '  ,RECLs2, 

♦  RECURDTYPEs 'FIXED' , FORMS 'UNFORM ATTED ' , 

♦  K£Ys(l:4:INTE5ER)) 

RETURN 


PDBPACK  CALLING  SEQUENCE 

PDBPACK 

- - SETCOLOR** 

j - SETGEO* 

’ - BLOCKIN 

i 

- MAPZUTM* 

- - UNGEN* 

t - MAPDRAW 

- FILLUP* 

- FEATURES* 

!  GRIDS* 

- LABEL* 

- PATCH  IT** 

- POLYDEF** 

- FILLUP* 

- FEATURES* 

- GEN* 


♦TERRAIN  SYSTEMS  UTILITIES 
♦♦"SURFACE"  ROUTINES 


Figure  B- 11 


0001  SUBROUTINE  BLOCK 1 N ( HAP ) 

00  02  *************************************.,***  **************** 

0003  *  THIS  ROUTINE  DETERMINES  WHICH  1 0 K K  BLUCKS  ARE  * 

0004  *  NEEDED  TO  COVER  A  MAP  AND  CAUSES  THESE  TO  BE  * 

0005  *  READ  IN.  * 

0006  ********************************************************* 

0007  *  INPUTS:  MAP—  THE  NAME  OF  THE  MAP  TO  BE  READ  IN  * 

0008  *  OUTPUTS:  NONE  * 

0009  ********************************************************* 

0010  INCLUDE  'CORNER. CMN' 

0011  1  ********************************************************** 


0012  1 
0013  1 

0014  1 

Oul5  1 
0016  1 
0017 
0018  1 
0019  1 

0020  1 
0021  1 
0022  1 
0023 
0024  1 

0025  1 

0026  1 
0027  1 

0028  1 
0029  1 

0030  1 

0031  1 

0032  1 

0033 
0034 
0035 
0036 
0037 
0038 
0039  C 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0047  C 
0048  C 
0049 
0050 


*  SWX , Sw Y  ARE  THE  SOUTHWEST  UTM  COORDINATES  OF  THE  * 

4  AREA  IN  THE  ARRAY  IBUF.  * 

I NTEGER  *4  SWX , SWY 
CJMMON/CORNER/SWX.SwY 

********************************************************** 
INCLUDE  'CMERID.CMN' 

**************************************************** 

REAL*8  CMER1D 
REAL  P-RAo 

COMMON/CM£RID/CMERlD,P.RAD 

**************************************************** 

INCLUDE  ' l TERRA  IN. SURFACE J  WINDO.CMN' 
************************************************************** 

*  F *  1 N X Y  CONTAINS  THE  X  MIN  AND  MAX  AwD  THE  Y  MIN  AND  * 

*  MAX  RESPECTIVELY  FOR  THE  WINDOW.  Ml N  AND  MAX  REFER  ♦ 

*  TO  THE  MIN  AND  MAX  OF  ELEVATION  VALUES,  AND  ZDElT  IS  * 

*  THE  CONTOUR  INTERVAL.  * 

************************************************************** 

DIMENSION  FWlNXY(4) 

COMMON/ wlNDO/FWlNXY,M IN, MAX, ZDELT 
************************************************************** 
CHARACTERS  MAP 
CHARACTERS  UTMSW,UTMNE 

CALL  MAP2UTM(MAP,FEA5T,FN0RTH,CMERID) 
IEASTsNINTCFEAST/1 0000. ) 410000 
NORTHS INTCFNORTH/l  0000.  )  *10000 
D  PRINT4,IEAST, NORTH 

SWX=IEAST-20000  1  MAP2UTM  RETURNS  THE  CENTER 
SWY=NORTH-20000  ! AND  A  40KM  SQUARE  IS  NEEDED 
CALL  UNSEN  iUNGEN  CAUSES  THE  DATA  TO  BE  READ  IN 

FWINXY( l)sSWX 
FWINXY(2)sFWINXY( 1)440000 
FWlNXY(3)=SwY 
FWINXYI 4)sFWINXYC3)+40000 
D  PR  I NT4 , FWI NX Y 

D  READ*, JUNK 

RETURN 
END 
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0001 
0002 
0003 
0004 
000b 
0006 
0007 
0008 
0009 
0010 
0011 
0012 
0013 
0014 
001b 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
0023 
0024 
002b 
0026 
0027 
0028 
0029 
0030 
0031 
0032 
0033 
0034 
003b 
0036 
0037 
0038 
0039 
0040 
0041 
0042 
0043 
0044 
004b 
0046 
0047 
0048 
0049 
0050 
00  51 
0052 
0053 
0054 
0055 
0056 
0057 


****** 

* 

* 

* 

* 

****** 


SUBROUTINE  MAPDKA* ( MAR , ERK ) 

******************************************************** 

*  THIS  ROUTINE  DISPLAYS  AND  FILLS  THE  DATA  FROM  * 

*  ONE  MAPSHEET.  * 

******************************************************** 

*  INPUTS:  Map--  THE  Name  of  the  map  IN  THE  M7 45  * 

*  SERIES  * 

*  OUTPUTS:  ERR--  AN  ERROR  FLAG  ♦ 

******************************************************** 

LJGICALM  ERR 

DIMENSION  PX(bOU) ,PY(50u) 

DIMENSION  PJLl (500,2) 

CHARACTERS  FN AME( 2 ) 

characters  map 
CHARACTERS  PREFIX(2) 

integers  iclr 

INCLUDE  '£ TERR AIN. SURFACE! WINDO.CMN' 
******************************************************** 
FWINXY  CONTAINS  THE  X  MIN  AND  MAX  AND  THE  Y  MIN  AND  * 

MAX  RESPECTIVELY  FOR  THE  WINDOW.  MIN  AND  MAX  REFER  * 

TO  THE  MIN  AND  MAX  OF  ELEVATION  VALUES,  AND  ZDELT  IS  * 

THE  CONTOUR  INTERVAL.  * 

******************************************************** 
DIMENSION  F hInXY (4) 

CJMMON/*IND0/FWINXY, MIN, MAX, ZDELT 
******************************************************** 
INCLUDE  'CORNER. CMN' 

**************************************************** 

SnX , Sw Y  ARE  THE  SOUTHWEST  UTM  COORDINATES  OF  THE  * 

AREA  IN  THE  ARRAY  1BUF.  * 

INTEGERS  SnX  , sw y 

common/cokner/swx,swy 

**************************************************** 

DATA  PREFIX/'F', 'U'/ 

EQUIVALENCE  (P0LY(1,1),PX(1)) 

EQUIVALENCE  ( POLY ( 1 , 2 ) , PY ( 1 )  ) 

LU=2 

DO  ICLR*1,2 

MAP(l:l)sPREFIX(ICLR) 

OPEN (NAME=MAP, UNI T=LU, ST ATUS=' OLD ', FORMS 'UNFORMATTED', ERR 
X=1  'JUST  TO  CAUSE  A  READ  TO  EOF 
DO  WHILE  (X.EU.l) 

KEAD(LU,ENDslOO)N, (PX(K),PY(K) ,Ksl ,N) 

DO  Jsl,N 

PX( J)sPX( J)-SWX 
PY( J)sPY( J)-SWY 
ENODJ 

CALL  F1LLUP(N, POLY, ICLR) 

ENDDO 

100  CLOSE(UNITsLU) 

ENDDO 

C...  FILLUP  CHANGES  THE  WINDOW  SETTING , SO .. . 

FWlNXY(l) sSwX 
FWlNXY(2)*SWX-f40000 

fwinxy  c  3 ) sswy 
FwlNXY(4)sSwY+40000 
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1  ****** 


1  ****** 
1  * 

1  * 

1 

1 

1  ****** 


MAPDRAW 


005b 

INCR=2 

0059 

CALL  FEATURES(INCR) 

0060 

CALL  L1NCLR(4) 

0061 

CALL  GRIDS 

0062 

RETURN 

006  J 

200 

CALL  CMCLJS 

0o64 

EKRs.TRUE. , 

0065 

CbOSk'lUNIT-LU) 

0066 

PRINT*, 'EKRUR  IN  MAP 

0067 

RETURN 

PROGRAM  PDBPACK 

********************************************************** 

*  THIS  ROUTINE  PACKS  THE  POLTGONAL  AREAL  DATA  FROM  * 

*  POHREAD  INTO  THE  1 OKM  TERRAIN  FILES  * 

********* ****************9******************************** 

CHAKACTER*5  NAM 
LOGICAL*!  ERR 
DATA  ERR/. FALSE./ 

CALL  SEICOLOR 
CALL  SETGEO 
DO  «H1LE  (.NOT. ERR) 

PRINT*, 'MAP?' 

10  FORHAK  A5) 

READ! 5 , 1 0 ) N AM 
CALL  BLOCKIN(NAM) 

CALL  MAPDRAn(NAM,ERR) 

CALL  CMOPEN 
CALL  NEwPAG 

call  lauel 

CALL  PATCHI1 
ENDDO 


POBREAO  CALLING  SEQUENCE 


PDBREAD 


-SETGEO* 


-NAMEREAD 


FILEREAD 


PDB2P0LY 


-CALIBR8 


-PARSER 


-DRAWR 


u, 


IAP2LL 


PARSER 
POLYWRITE 
LL  i - D 


DELTA 


-PARSER 


-PARSER 


1 - POLYWRITE 

I - DELTA 


*Terrain  System  Utility 
Figure  B-13 


PROGRAM:  PDBREAD 


SETGEO 


0001 

0002 

0003 

0004 

000b 

0006 

0007 

0000 

0009 

0010 

0011 

0012 

0013 

0014 

001b 

0016 

0017 

0018 

0019 

0020 

0021 

0022 

0023 

0024 

002b 

002o 

0027 

0028 

0029 

0030 

0031 

0032 

0033 

0034 

0035 

0036 

0037 

0038 

0039 

0040 

0041 

0042 

0043 

0044 

004b 

0046 

0047 

0048 

0049 

0050 

0051 

0052 

0053 

0054 

0055 

0056 

0057 


SUBROUTINE  CALI BR 8 ( FNAME, FDM , ERR ) 
**************************************************  **,.****** 
THIS  SUBROUTINE  CHECKS  THE  HEADER  FDM ,  THE  SKEW-  * 
CORRECTION  FDM,  AND  SETS  THE  X-  AND  Y-CAL1BKATI ON  * 
****************************** ***************************** 
INPUTS:  FnAME--  THE  NAME  OF  AN  M745-SER1ES  MAP,  * 
WITH  A  'U'  OR  'F'  (URbAN  OR  FOREST)  AS  THE  * 
FIRST  CHARACTER.  * 

OUTPUTS:  FDM--  FUNCTION  DEFINITION  MODULE  TYPE  * 

*********************************************************** 


LOGICAL  ERR 
CHARACTERS  FNAME 
-DIMENSION  XX ( 4 ) , Y  Y ( 4 ) 

INCLUDE  'MAPDAT.CMN' 

1  ************************************************************* 
1  REAL  X , Y  1  CURSOR  POSITION 

1  REAL  XCENTR, YCENTR  »UTM  CENTER  OF  MAP 

1  REAL  XSCALE , Y SCALE  • METERS/ TABLET  UNIT 

1  ************************************************************* 
1  COMMON/MAPDAT/X, Y,XCNTR, YCNTR, XSCALE, YSCALE 

1  ************************************************************* 
1 
1 

INCLUDE  'WORDS. CMN' 

1  ************************************************************ 

1  INTEGERS  PTR  i POINTS  TO  CURRENT  BYTE 

1  INTEGERS  N.BYTES  INUMBEk  UF  BYTES  IN  FILE 

1  BYTE  BYTES! 1 1264)  !44  BLOCKS  ON  THE  4081 

1  INTEGERS  NURDS (5632)!THE  MAP  COORDINATES  ARE  1*2 

1  EUUIVALENCE  (W0RDS(1),BYTES(1)) 

1  C OM MON / NOR DS/ BYTES, N.BYTES , PTR 

1  ************************************************************ 

1 


INCLUDE  'FDM. PAR' 

1  *********************************************************** 
1  INTEGERS  FDM,L-R-M,L«R-D,S_R-M,S.R-D 

1  PARAMETER! 

1  +  HEADER=16,  ! CODE  FOR  THE  HEADER  MODULE 

1  +  L.R.Ms  28,  ! LONG  RELATIVE  MOVE 

1  ♦  L.R.Ds  29,  'LONG  RELATIVE  DRAW 

1  ♦  S-R.Ms  32,  ! SHORT  RELATIVE  MOVE 

1  +  S.R.Db  33)  ! SHOR I  RELATIVE  DRAn 

1  *********************************************************** 


C. 


C. 


CHECK  HEADER  FDM 

IF(BYTES(2)*NE. HEADER. OR. BYTES(1).NE.14)THEN 
WRITE (3,1)  FNAME, BYTES! 2 ),BYTES(1) 
FORMAKIX,  'BAD  HEADER  FDM  IN  :  ',A5,2I2) 
EKRs. TRUE. 

RETURN 

ENDIF 

RESETTING  THE  CURSOR  POSITIONS. 

X  =  0 
Y=0 


C...  CHECK  FOR  SKEW  CORRECTION  MOVES 
PTR=16 

FDMsBYTES(PTR) 
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oos>8 

0059 

0060 

0061 

0062 

0063 

0064 

006b 

0066 

0067  C... 

0066  C... 

0069  C... 

0070 

0071 

0072 

0073 

0074 

0075 

0076 

0077 

0078 

0079 

0080  C... 

0081  C... 

0082  C... 

0083  C... 

0084  C... 

0085 
0086 
0087 

0088  C... 

0089 

0090  C  D 

0091 

0092 


!► l r  DM . EQ . L«R_M ) THEN 
PTHsl7 

CALL  MOVR  ( FDM ,  ERR  ) 

I  F( ERR ) RETURN 
ELSE 

ERRs. TRUE. 

RETURN 

EN01F 

check  calibration  fdm 

SETTING  THE  SCALE  TO  1  STOPS  THE  INFO  FROM 
BEING  WRITTEN  BY  POLYWRITE 
XSCALEs 1 
YSCALE=1 

1F( FDM. EO.L.R.D) THEN 
CALL  ORAWR(FDM,ERR) 

ELSE 

WKITE(3,*) 'BAD  CALIBRATION ' 

ERRs. TRUE. 

RETURN 

ENDIF 

ORIGINALLY  THE  CALIBRATIONS  WERE  SET  FROM  THE 
DIGITIZED  10KM  LINES 
RESET  THE  X-  AND  1-SCALES 

THE  MAPSHEETS  ARE  20  X  12  MINUTES,  AND  THE 
DIGITIZER  TABLET  WINDOW  IS  10000  X  7500,  SO... 
XSCALEs. 000033333 
Y SCALE=. 000026667 
ERRs. FALSE. 

SET  UTM  CENTER  OF  MAP 

CALL  MAP2LL(FNAME,XCNTR, YCNTR) 

PRINT*, 'CNTR  IN  CAL1BR8:  ', XCNTR , YCNTR 

RETURN 

END 
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0001  FUNCTION  DElTA(X1,Y1,X2,Y2) 

0002  **************************************************************** 

0003  *  THIS  FUNCTION  COMPUTES  THE  DISTANCE  BETWEEN  THE  POINTS  * 

0004  *  (XI, Y2)  AND  (X2,Y2).  * 

0005  ********************* **************************  ***************** 

OOOb  Ds(Xl“X2)**2+(Yl“Y 2)**2 

000  DELTAsSJRT(U) 

OOOb  RETURN 

0009  END 


% 


0001  SUBROUTINE  DR# *•'•<(  FO  ,  ERR ) 

0002  ************************* ************************************ 

OOOJ  *  PUTS  THE  PARSED  MOVES  INTO  POlY  AM)  CALLS  POLY  W RITE  * 

0004  *  IF  I  HE  NEXT  FDM  INDICATES  A  MOVE.  * 

000b  **********************  *************************************** 

000b  LOGICAL  FRR 

0007  REAL  POLY ( 1 000 , 2 ) 

0008  INTEGER*2  P , ARRAY ! 1 200 ), W.LEN 

0009  INCLUDE  'MAPDAT.CMN' 

0010  1  ************************************************************* 
0011  1  REAL  X ,  Y  'CURSOR  POSITION 

0012  1  REAL  XCEN TR , Y CENTk  • UTM  CENTER  OF  MAP 

0013  1  REAL  XSCALE, YSCALE  1 METERS/TAbLET  UNIT 

0014  1  ************************************************************* 

001b  1  C3MM0N/NAPDAT/X, Y,XCNTR,YCNTR, XSCALE, YSCALE 

00  lb  1  ************************************************************* 
0017  1 

0018  1 

0019  INCLUDE  'WORDS. CMN' 

0020  1  ************************************************************ 
0021  1  INTEGERS  PTR  'POINTS  TO  CURRENT  BYTE 

0022  1  INTEGERS  N. BYTES  'NUMBER  OF  BYTES  IN  FILE 

0023  1  BYTE  BYTESU1264)  !44  BLOCKS  ON  THE  4081 

0024  1  INTEGERS  NURDS ( 5632 )!  THE  MAP  COORDINATES  ARE  1*2 

002b  1  EQUIVALENCE  ! WORDS! 1 ), BYTES! 1 ) ) 

002o  1  COMMON /WORDS/ BY  TES , N_bY IES , PTR 

0027  1  ************************************************************ 

0028  1 

0029  INCLUDE  'FDM. PAR' 

0030  1  *********************************************************** 


0031 

1 

I NTEGER*2  FDM , L.R-M , L.R.D , S_R_M , S_R_D 

0032 

1 

PARAMETER! 

0033 

1 

♦ 

H£ADEK=16,  JCODE  FOR  THE  HEADER  MODULE 

0034 

1 

L-R-Ms  28,  !  LONG  RELATIVE  MOVE 

003b 

1 

L-R_D=  29,  !  LONG  RELATIVE  DRAW 

003b 

1 

* 

S-R-Ms  32,  ! SHORT  RELATIVE  MOVE 

0037 

1 

* 

S.R.Ds  33)  iSHORT  RELATIVE  DRAW 

0038 

1 

*********************************************************** 

0039 

DATA  P/1/ 

0040 

ERRs. FALSE. 

0041 

IPslPTR-D/2 

0042 

LENsISHFT! ISHFT ! WORDS ! I P) , 8) ,-8)-2  '2-BYTE  HEADERS 

0043 

W-LENs30/FDM+l  IOR  29  OK  31  OR  32... 

0044 

LENsLEN/WJLEN 

0045 

CALL  PARS£R!AKRAY,W„LEN,L£N,EKR) 

0046 

1 F ! ERR ) RETURN 

0047 

DO  1=1 , LEN , 2 

0048 

POLY !P, 1 )=X 

0049 

POLY (P , 2 ) * Y 

0050 

X=X+ ARRAY  !  I  ) 

0051 

Y=Y+ARRAY! 1*1) 

0052 

P=P*1 

0053 

ENDDO 

0054 

POLY ( P , 1 ) =X  1THE  END  OF  THE  LAS/  DRAW 

0055 

POLY ! P, 2 ) *  Y 

0056 

FDMsBYTESIPTR) 

0057 

PTRsPTRtl 
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OObB  C...  IF  THE  NEXT  FUM  IS  A  MOVE  OK  IF  THIS  IS  THE  END  OF  inu 

00b9  C...  INPUT  FILE  THEN  WRITE  THE  CURRENT  POLYGON. 

0060  IF(FDM,EO.L.R_M.OK.FDH.EO. S_R_M ,OR.PTR.GE.N_BYTES)THEN 

0061  CALL  POLYWRITE(PULY,P) 

0062  P=1 

0063  ENOIF 

0064  RETURN 


SUBROUTINE  FI LEKE AD ( 
**************************** 

*  READS  A  PICTURE  DATA 

*  transferred  from  the 
******** 

LOGICAL  ERR 
INCLUDE  'MOKDS.CMn' 
*****************  *********** 
I NTEGER*2  PTR 

integers  n.bytes 

RYTE  tJYTESd  1264) 

1 NTEGER  *2  *ORDS(5632 
EQUIVALENCE  (*ORDSd 
CJMMON/*OrDS/ BYTES,  N 

*************************1** 


ERR) 

************************************ 

BASE  ( PDB)  FILE  «HiCH  HAS  BEEN  * 
TEK  40a 1  AND  PUTS  IT  INTO  'BYTES'  * 
******************* 


******************************** 

! PDT NTS  TO  CURRENT  BYTE 
INUMBER  UF  EYTES  IN  FILE 
144  BLOCKS  ON  THE  4081 
) 1  THE  MAP  COORDINATES  ARE  1*2 
) , BYTES( 1 ) ) 

-BYTES, PTR 

******************************** 


ERR  =  , FALSE. 

N-BYTESsO 

DO  wHIL£( .NOT. ERR) 

REAIK1 ,10,END=100,ERRs200)N, (BYTESCI) , 1=N.BY TES+1 , N.BTT! 
N_BYfES=N.BYTES+N 
ENDDO 

FJR*At( J,256A1) 

RETURN 
ERR-. TRUE. 

RETUHN 


- 
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SUBROUTINE  MAP2LL(FNAME, FLOW, FLAT) 
************************************************** 

*  THIS  RUUTlNE  COMPUTES  ThE  LAT,LO’J  OF  THE  * 

*  CENTER  OF  A  SHEET  FROM  THE  h745  SERIES.  * 
************************************************** 

*  INPUTS:'  fname—  the  name  of  the  map  * 

*  outputs:  flun,flai--  real-valued  lat  and  * 

*  LON  OF  THE  CENTER  OF  THe  MAP  * 

*********************  ********************  ********* 

CHARACTER*5  FNAME 
DIMENSION  012) 

PARAMETER  PI =3 . 1 4 1 592b54 
P—RADsPl/180. 

DO  1=2, 4,2 

DECODE! 2, 10,FNAME(I :l+l ) )  DC1/2) 

ENDDO 

10  FORMAT! F3. 0) 

DLAT=50*!59-DQ)  )/2.*.2+.l 
DL0NS9+  tn(2)-20)/2./3.  +  l ,/6. 

Fl,AT  =  DLAT*P_RAD 
FbON = DL ON *P_R AD 
RETURN 
END 


SUHKOUT I NE  MOVR(FDM,ERK) 

********************************************************** 

*  RECOMPUTES  THE  CURS  JR  POSITION  AMI)  INDEX  AFTER  A  * 

*  RELATIVE  ROVE  HAS  BEEN  PARSED.  * 

******************************* **************************** 

*  INPUTS;  FDM--  THE  CODE  FOR  THE  FDR  TYPE  * 

*  OJTPUTSl  ERR—  ERROR  FLAG  * 

***************! ******************************************** 

LOGICAL  ERR 

INTEGERS  FdR,H.LEN,LEN,  ARRAY120)  J  MOVES  SHOULD  BE  SHORT 
INCLUDE  'MAPDaT.CmN' 

************************************************************* 
REAL  X,Y  'CURSOR  POSITION 

REAL  XCENTR,  YCENTr  HUM  CENTER  OF  MAP 
REAL  XSCALE, YSCALE  • METERS/TAbLET  UNIT 
************************************************************* 
COMMON/ M APD AT/X, Y,XCNTR, YCNTR, XSCALE, YSCALE 
************************************************************* 


INCLUDE  'MORDS.CMN' 

************************************************************ 
I NTEGER*2  PTR  'POINTS  TO  CURRENT  BYTE 

INTEGERS  N. BYTES  iNUMBER  OF  BYTES  IN  FILE 

BYTE  B  Y  i'ES  (  1 1264  )  !  44  BLOCKS  ON  THE  4081 

I NTEGtK *2  MORDS(5b32) iTHE  MAP  COORDINATES  ARE  1*2 
EJU1VALENCE  (*0RDS(1),BYTES(1)) 

COMMON/ NOHDS/bYTES, N_H YTES , PTR 
************************************************************ 

ERRs. FALSE. 

LEN=BYTES(PTR-2)-2  12-BYTE  HEADERS 
M.LENs30/FDM*l  'OR  2*, OR  31  OR  32... 

LENsLEN/MUiEN 

CALL  PARS£RlARRAY,W„LEN,LEN,ERR) 

IF (ERR) RETURN 
DO  I=1,LEN,2 
XsX+ ARRAY ( I ) 

Ysy+ARHAY ( 1*1 } 

ENDOO 

FUM=BYTES(PTRJ 
PTRsPTR+1 
RETURN 
END 
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SUBROUT i  NE  NAttEhEAD(NAMElN,EOF) 

****************************************************** 

*  READS  FILE  NAMES  FOR  PROCESSING  OF  FILES  BY  * 

*  PDBREAD"  * 

****************************************************** 

*  inputs:  none  * 

*  OUTPUTS:  NAME1N--  NEXT  FILE  TO  BE  PROCESSED  * 

*  EOF—  FLAG  SIGNALLING  END  OF  NAME  * 

*  FILE  * 

****************************************************** 

CHARACTER* 9  NAMEIN 
LOGICAL  EOF 
EOFs. FALSE. 

READ(7f 10,END=100)NAMEIN  !  FOR007  CONTAINS 
10  FORMAT! A9)  i  THE  FILE  NAMES 

RETURN 

100  EOFs. TRUE. 

RETURN 

END 
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SO&KOUTlNt  PARSER (ARRAY , w„LKN , LEN , ERR ) 
*******************************»*********************************** 

*  'PARSES'  THE  CURRENT  FDR  (FUNCTION  DEFINITION  MODULE) .  * 

******************************************************************* 

*  inputs:  * 

*  W.LEN  —  THE  WORD  LENGTH  OF  THE  DATA  ( 1  OR  2  BYTES)  * 

*  LtN--  THE  LENGTH  OF  THE  ARRAY  IN  W.LEN  UNITS  * 

*  OUTPUTS:  ARRAY--  THE  PARSED  DATA  * 

******************************************************************* 

INTEGER*2  W.LEN , LEN , ARRAY ( 0 : LEN ) 

LOGICAL  ERR 
INCLUOE  'aOKDS.CMN' 

************************************************************ 

INTEGERR2  PTR  ‘POINTS  TO  CURRENT  BYTE 

integer *2  n. bytes  ‘number  of  bytes  in  file 

BYTE  BY TES (11264)  ‘44  BLOCKS  ON  THE  4081 

INTEGERS  RORDS(5632)  ITHE  MAP  COORDINATES  ARE  1*2 
EQUIVALENCE  ( WORDS ( 1 ), BYTES ( 1 )  ) 

COM MON /» OR DS/ BYTES, N— B  YTES,PTK 

************************************************************ 

I F ( W.LEN . EQ . 1 ) THEN 
DO  1=0 , LEN-1 , 2 

ARRAY ( 1)=BYTES(PTK*I* 1  ) 

ARRAY ( 1*1 )=BYTES(PTR+I ) 

ENDOO 

ELSE  IF(W.LEN.E0.2)THEN 
P=(PTK*l)/2 
DO  1=0, LEN-1 

ARRAY (1)  =  W0RDS(P+I ) 

ENDDO 

ELSE 

WRITE(3,*) 'INVALID  WORD-LENGTH  IN  PARSER:  ',W.LEN 
EKR=. TRUE. 

RETURN 

ENDIF 

PTR=PTR**.LEN*LEN+1  ‘THE  FDM  CODE  WILL  BE  ACCESSED  NEXT 

RETURN 

END 
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SUBROUTINE  PDB2P0LY  (FNAMF.) 

*********************************************************** 

*  THIS  SUBROUTINE  TRANSFORMS  THE  RELATIVE  DATA  FROM  * 

*  THE  DIGITIZER-PRODUCED  PDB  FILES  INTO  VERTICES  OF  * 

*  POLYGONS  IN  UTM  COORDINATES.  * 

*********************************************************** 

*  INPUTS!  FNAME  —  THE  NAME  OF  THE  INPUT  FILE  * 

*********************************************************** 

CHARACTER*5  FNAME 
LOGICAL  ERR 
INCLUDE  'MAPDAT.CMN' 

************************************************************* 
REAL  X,Y  'CURSOR  POSITION 

REAL  XCENTR, YCEnTR  »UTM  CENTER  OF  MAP 
REAL  XSCALE, YSCALE  ! METERS/TABLET  UNIT 
************************************************************* 
COMMON/ NAPDAT/X,Y,XCNTR,YCNTR, XSCALE, YSCALE 
************************************************************* 


INCLUDE  'WORDS. CMN' 

************************************************************ 

I NTEGER*2  PTR  iPOINTS  TO  CURRENT  BYTE 

integers  n.bytes  'number  uf  bytes  in  file 

BYTE  BYTES! 1 1 264)  ! 44  BLOCKS  ON  THE  4081 

INTEGERS  H0RDS(5632) 'THE  MAP  COORDINATES  ARE  142 
EJUIVALENCE  (mORDS(1),BYTE5(1)) 

COMMON/ NOR DS /BYTES, N.BYTES , PTR 

************************************************************ 
INCLUDE  'FORFAR' 

*********************************************************** 


I NTEGER *2  FuM , L.R.M , L.R.D , S_R_M , S.R.D 
PARAMETER! 


HEADERS 

i6. 

! CODE  FOR  THE  HEADER  MODULE 

♦ 

L-R.M= 

28, 

•LONG  RELATIVE 

MOVE 

* 

L.R_D= 

29, 

•LONG  RELATIVE 

DRAW 

♦ 

S.R.M = 

32,  • 

•SHORT  RELATIVE 

MOVE 

♦ 

S.R.Ds 

33) 

•SHORT  RELATIVE 

DRAW 

*********************************************************** 
ERRs. FALSE. 

23  FORMAT( 1 X , A5 ) 

WR1TE(6,23)FNAME 

CALL  CALIBR8(FNAME,FDM,ERR) 

DO  WHILE( ( PTR. LT. N.BYTES) .AND. ( .NOT. ERR)) 

I F( ( FDM . EQ. S.R.M ) . OR . ( FDM . EO. L.R.M ) )  THEN 
CALL  MOV R ( FDM , ERR ) 

ELSE  IF((FDM.EU.S-R-D). OR. (FDM. EU. L.R.D))  THEN 
CALL  DRAwR ( FDM , ERR ) 

ELSE 

ERRs. TRUE. 

•RITE (3,*)'lN  FILE  ', FNAME,'  BAD  FDM:  ' , FDM 
RETURN 

endif 

ENDDQ 

RETURN 
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PROGRAM  POBKEAO 

*  THIS  PACKAGE  PRuCESSES  THE  408 1 -PRODUCED  PDB  FILES  INTO  * 

*  POLYGONS  nHICH  CAN  dE  DISPLAYED  AND  PACKED  INTO  SURFACE  * 

*  FEATURE  CODES  IN  THE  TERRAIN  DATA  FILES  BY  THE  ROUTINE  * 

*  POHPACK.  * 

************* 4* *9*9999* 9* 99 9*9  ********  *************  9* *9*99*9* 99 99 

LOGICAL  EOF, ERR 
INCLUDE  'mOKDS.CMn' 

************************************************************ 

INTEGERS  PTR  iPOINTS  TO  CURRENT  BYTE 

INTEGERS  N. BYTES  ‘NUMBER  UF  BYTES  IN  FILE 

BYTE  BYTES! 11264)  J44  BLOCKS  ON  THE  4081 

INTEGERS  WORDS ( 5b3 2 ) 1  THE  MAP  COORDINATES  ARE  1*2 
EQUIVALENCE  ( nORDS ( 1 ), BYTES C 1 )  ) 

COMMON/ WOROS/bYTES,N-dYTES, PTR 

************************************************************ 

CHARACTERS  NAMEIN  ,  NAmEOUT 
DATA  EOF/. FALSE./, ERR/. FALSE./ 

CHARACTERS  NAM 
EQUIVALENCE  (NAMEIN, NAM) 

OPEN (UNIT=3, NAME* 'PDBERR.TXT', STATUS* 'NEW') 

OPEN (UN1Ts7,NAME*'PDB. TXT', STATUS* 'OLD') 

CALL  SETGED 
DO  •HILE(.NOT.EOF) 

CALL  NAM£READ(NAMEIN,EOF) 

OPEN ( UNI T*1,NAME*NAMEIN, TYPE* 'OLD', FORM* 'FORMATTED') 
NAMEOUr=NAM//'.DAT' 

OPEN (UNI T*2,NAME*NAHE0UT, TYPE* 'NEW ', FORM* 'UNFORMATTED') 
CALL  FlLEREAD(ERR) 

*R1T£( 3,*) NAMEIN, N.BYTES 
CALL  PDB2P0LY (NAM, ERR) 

CLOSE! JN1T=1 ) 

CLOSE (UNIT* 2) 

ENDDO 

END 
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SJHR0UT1NE  POLYWRlTE(POLY,P) 

*******  *  ***** 4* **********************  ************  ******** 

*  this  scales, translates, and  writes  the  digitized  * 

*  DATA  WHICH  HAS  BEEN  TRANSFORMED  FROM  kELAIIVE  * 

*  TJ  ABSOLUTE  FORM .  AND  WRITES  THE  DATA  TO  FILE  2  * 

********************************************************* 

INTEGERS  P  !  •  OF  VERTICES 

DIMENSION  PULY ( 1000, 2)  iVERTICES  OF  A  POLYGON 
REAL  P1,P2 

INCLUDE  'CMERID.CmN' 

1  **************************************************** 

1  REAL*8  CMER1D 

1  REAL  P_RAD 

1  C JMRON/CMERiD/CMERlD,P-RAD 

1  **************************************************** 

INCLUDE  'MAPDAT.CMN' 

1  ************************************************************* 

1  REAL  X , Y  'CURSOR  POSITION 

1  REAL  XCENTR, YCENTR  »UTM  CENTER  OF  MAP 

1  REAL  XSCAL£,YSCaLE  • METERS/TABLET  UNIT 

1  ************************************************************* 

1  CJMMON/MAPDAT/X,Y,XCNTR,YCNTR, XSCALE , Y SCALE 

1  ************************************************************* 

C...  THE.  OLD  SCALING  INFO  IS  NOT  WRITTEN 

IF(XSCALE.N£.1.)THEN 

C...  CONVERT  THE  ANGULAR  MEASUREMENTS  TO  UTM 

PI -POLY  (1,1  )*P«.RAD*XSCALE+XCNTR 
P2=POLY(l,2)*P-RAD*YSCALE+YCNIR 
CALL  ADSMPfP2,Pl ,CMERID, FEAST, FNORTH) 
P0LY(1,1)=FEAST*500000. 

P0LY(1 ,2)=FN0RTH 

NPTS=1 

DO  1*2, P 

PlsP0LY(I,i)*P.RAD*X5CALE+XCNTR 
P2=POLY(I,2)*P-RAD*Y$CALF.*YCNTR 
CALL  ADSMPIP2, Pi, CMER1D, FEAST, FNORTH) 

P1*FEAST*-500000, 

P2*FNURTH 

C...  IF  THE  POINTS  ARE  REASONABLY  FAR  APART... 

IFC DELTA! POLY (NPTS,1), POLY (NPTS, 2) , PI, P2).GT. 200.) THEN 
nptssnpts+i 
POLY(NPTS, 1)*P1 
P0LY(NPTS,2)=P2 
ENDIF 
FNDOO 

IF ( DELTA! POLY (NPTS, 1), POLY (NPTS, 2), POLY (1,1), POLY  Cl, 2 )).GT 
NPTS=NPTS+1 
ENDIF 

POLY ( NPTS, 1 )*pOLY (1,1) 

POLY ( NPTS, 2 )*POLY (1,2) 

WRITE(2)NPTS,((POLY(I,J),Jsl,2),I*l, NPTS) 

NPTS*0 

ENDIF 

RETURN 

END 
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RQADHEXER  CALLING  SEQUENCE 


ROADHEXER 

- HEXINIT* 

- OPENERS* 

i - GRIDR* 

- 1 GRID* 

- NODEHEX 

- GETNDX* 

- GETREC* 

- N0D2HX 

I 

- TRANX* 

- TRANY* 

1 - LINKHEX 

- GETNDX* 

- GETREC* 

- GETSUB* 

r - HEXSUB 

- TRANX* 

- TRANY* 

- HXRECORD 

- HEXREAD* 

- PACKER* 

- N0D2HX 

- TRANX* 

- TRANY* 

1 - HXRECORD 

- HEXREAD* 

- PACKER* 

♦Terrain  System  Utilities 
Figure  B-15 


0001  SUBROUTINE  HEXSUB ( HEX A , HEXB , N ) 

0002  44***99*9**4*** ************  ******************** 
000 J  *  BEGINNING  AT  HEX A ,  WHICH  CONTAINS  THE  * 
0004  *  START  NJDE,  A  CHAIN  OF  ADJACENT  HEXES  * 
000b  *  IS  GENERATED  TO  HEX b *  WHICH  CONTAINS  * 
0006  *  THE  STOP  NODE  FUR  A  LINK.  * 
0007  444**4*4*4**9******494*4*9*4*4*44449*4994*4**4* 


0008 

0009 

0010 

0011 

0012 

0013 

O0l4 

001b 

001b 
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0019 

0020 
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0022 
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002b 

002b 

0027 
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0040 
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0044 

004b 

0046 
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0049 

OObO 

0051 

0052 

0053 

0054 

0055 

0056 

0057 


*  inputs:  * 

*  HEX A , HEXB"-  THE  HEXES  *H1CH  * 

4  CONTAIN  THE  TERMINAL  NUDES  * 

4  N—  THE  NUMBER  OF  SUbNODES,  4 

4  NOT  COUNTING  THE  ENDPOINTS.  4 

99994449*9 4* 49444949 *94*49494*9949*944999*49999 

IMPLICIT  INTEGER  (H,P) 

INCLUDE-'JTILsSUB.CmN' 

99449*44*49499*44***9949* 44 4*44999499 944*494*944*4*4*99449* 
4  SUBX.SUbX  THE  X  AND  Y  COORDINATES  Ot-  THE  SUBNODES  * 

4  IN  ONE  LINK  (SEE  BDM  DOCUMENTATION)  * 

4*94994**444*444*44*44*4*4*44*444494**4**44*994**4**4*99*94 

INTEGER42  S JBX ( 1 0 0 ) , SUB Y ( 1 00 ) 

COMMON/SUB/  SUBX , SUbY 

49999***94**444*****9*4*4444949*999*449**4*4*****4*999*4*4 
INCLUDE  'JTILSCENTER.CMN' 

99499499949******99*99*44449****4**4***99449999*44***94*99 
4  THE  CENTER  OF  THE  HEX  GRID  IS  AT  XORIGIN , YORIGIN  4 

4  WHERE  THE  COORDINATES  ARE  IN  METERS  UTM  RELATIVE  4 

4  TO  A  GIVEN  GRID  ZONE.  4 

949**944*4*4*4*99444*449*9*9*94**99*99**9**9*994*9*9*49*99 
1NTEGER44  XORIGIN, YORIGIN 
COM MON/ CENTER /XORIGIN, YORIGIN 
DATA  XO RIGIN/bOOO 00 /fY0KlGlN/b7 00000/ 

*9*4*9*499*9*** ****** 9* *99***4*9*«*******«*999****94**4**9 
LEV=4 

* 

HEXSTARTsHEXA 
HEXST JP=HEXb 

4 


I  »0 

HEXC=-1  !  NOT  A  VALID  HEX  • 

*  PROCESS  THE  SUBNODE  LIST  UNTIL  THE  LINK  * 

9  ENTERS  THE  TERMINAL  HEX  * 

DO  wHILE(HEXC.NE.HEXSTOP) 

1*1*1 

X=TRANX(SUBX(I) ) -XORIGIN 
Y=TRANY(SUBYlI ) )- YORIGIN 
CALL  XYL2HA(X, ¥,LEV,HEXC) 

4  IF  THE  SUBNODE  IS  NOT  IN  HEXA...  * 

IF(HEXSIART.NE.HEXC) THEN 

CALL  HXRECORD(HEXSTART,HEXCrIADJ) 

4  ...BUT  IS  IN  AN  ADJACENT  HEX  * 

IFdADJ.EU.  1 )  THEN 

*  ...AND  IS  NOT  IN  HEXB  9 

ifchexc.ne.hexstopjthen 

CALL  HXRECORD(HEXC,HEXSTOP,IADJ) 

*  ...THEN  IF  IT  IS  ADJACENT  TO  HEXB... 

IF(IADJ.EO. 1 ) THEN 

*  DONE  * 
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0001  SUBROUT.lNr  ri  <  •  ECOkD  l  H  A  ,  HB ,  I  ERR  ) 

000  2 

0003  ♦  THIS  ROUHNt,  COMPUTES  TnE  SIDE  AT  WHICH  HEXA 

0004  *  IS  ADJACENT  TJ  HEXB.  IT  PASSES  THIS  INFORMATION 

0005  ♦  TJ  PACKER.  T  ,t'N  IT  INVERTS  Tut  SIDE  AND  PASSES 

0006  *  TrtE  INVERlEu  SIDE  AlOnG  WITH  HEXB  AnD  TYPE  TO 

0007  *  PACKER.  THIS  IS  DONE  1U  INSURE  THAT  THE  CONNEC- 

000b  *  T1V1TY  LOOKS  l'HE  SAME  FROM  BOTH  HEXES.  SINCE  ONLY 

000*  *  OJTLINKS  ARE  CHECKED,  SOMETHING  OF  THIS  SORT  IS 

0010  *  NECESSARY. 

0011  4*4 « * ********** ****** **********  ********************* ********** 

0012  *  INPUT:  HA — THE  HEX  ADDRESS  OF  THE  FIRST  SUBNJDE 

0013  *  HB--THE  HEX  ADDRESS  OF  THE  SECOND  SUBnOUE 

0014  4  OUTPUT:  IERK —  AN  ERROR  FLAG 

0015  *************** ****************************»********4*4******* 

001b  IMPLICIT  I N  TEGEK (  H  ,  P ) 

0017  INCLUDE  'U TI L : PACK . CMN ' 

0018  1  ******4 ***********4***  ************************************ 

0019  1  I N TEGER *4  SIDES  1  PACKED  CONNECTIVITIES  * 

0020  1  INTEGER*4  LTYPE  i  CONNECT! VITY  FOR  CURRENT  SIDE  * 

0021  1  COMMON/PACK/SIDES, LTYPE 

0022  1  **4*4*4***4***4*********4********************************* 

0023  * 

0024  *  SUBTRACT  BY  ADDING  THE  INVERSE 

0025  4  HSTJRB  IS  THE  INVERSE  OF  THE  SIDE  AT  WHICH 

Oo2b  4  HEXB  IS  ADJACENT  TO  HEXA 

0027  *  HSTUR A  AND  HSTORB  ARE  IN  INTERNAL  HEX  FORMAT 

0028  HSTORB=HXADD( JA,HX1NVCHB) ) 

0029  HSTUR A* HX1NV( HSTORB) 

0030  » 

0031  *  GET  THE  RECORD  FOR  HEX  'HA'  OK  CAUSE  IT  TO 

0032  *  BE  INITIALIZED  IF  NECESSARY 

0033  LU  =  7 

0034  CALL  HEXREAD(HA,SiD£5,LU) 

0035  * 

003b  *  I ERH  IS  A  FLAG  INDICATING  THAT  TWO  ADJACENT 

003/  *  SUBNOUES  WERE  NOT  IN  ADJACEM  HEXES 

0038  * 

0039  CALL  PACKEK1Hm,HSI0KA, IEKK,LUJ 

Ou40  IF  (  IEKR.EU.*0)RETURN 

0041  » 

0042  4  NJW  FOR  THE  SECOND  HEX 

0043  4 

0044  4  HSTORB  IS  THE  SIDE  OF  HEXb  AT  WHICH  HEXA 

0045  *  IS  ADJACENT 

004b  4 

0047  CALL  HEXREAD(HB, SIDES, LU) 

0048  CALL  PACKERCHB, HSTORB, IERH,LU) 

0049  4  THERE  SHOULD  BE  NO  ERROR  IF  IT  GETS  PAST 

0050  4  THE  FIRST  CALL  TO  PACKER. 

0051  RETURN 

0052  END 
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0048 

0049 

0050 

0051 

0052 

0053 

0054 

0055 
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0057 


SJBROUTINt  LlNKHEX(LNKNJM,HtXA) 
t«*MMMMM**M*M*MM«*M*MM**MM*M*MMfM*M 

*  THIS  ROUTINE  CHECKS  ThE  LINK  TYPF  FDR  * 

*  each  link  incident  to  a  node,  if  the  * 

*  TYPE  IS  BETWEEN  1  AND  3  (le;  IF  THE  LINK  * 

*  REPRESENTS  A  ROAD)  THEN  THE  TERMINAL  HEX  * 

*  F JR  THIS  LINK  IS  OBTAINED  FkOM  N0D2HX .  * 

*  IF  THE  LINK  CONNECTS  TRU  HEXES  THEN  THE  * 

4  SUBNODES  COORDINATES  ARE  READ  IN  AND  EACH  * 

*  PAIR  OF  ADJACENT  SUBNUDEStAND  THE  START  * 

*  AND  STOP  HEXES)  ARE  PROCESSED  BY  HXRECORD.  * 

****************************************************** 

*  INPUT!  * 

*  LNKNUM--  POINTER  TO  THE  LINK  RECORD  * 

*  HEXA--  HEX  CONTAINING  THE  NUDE  * 

****************************************************** 

IMPLICIT  INTEGER  (H,P) 

INTEGERS  TMPLINK 

INTEGER44  RRDPOS , SRECNUM , SUBWKD 

*  IF  THE  LINK  CONNECTS  T  R  0  DIFFERENT  HEXES r  THEN 
INCLUDE  'UTlLlSUB.CMN' 

*********************************************************** 

*  SUBX.SUBY  THE  X  AND  Y  COORDINATES  OF  THE  SUBNODES  * 

*  IN  ONE  LINK  (SEE  BDM  DOCUMENTATION)  » 

*********************************************************** 

INTEGERS  SUBX(100),SUBY(100) 
common/sub/  SJRX,SUBY 

********************************************************** 

INCLUDE  'UTILIPACK.CMN' 

********************************************************** 

INTEGEKM  SIDES  •  PACKED  CONNECTIVITIES  * 

INTEGER»4  LTYPE  !  CONNECTIVITY  FOR  CURRENT  SIDE  * 

common/pack/ sides, ltype 

********************************************************** 

INCLUDE  'UT1LJLNKN0D.CMN' 

**************************************************************** 

*  ARRAYS  FOR  THE  GRID , NODE , LI NK , AND  SUBNODE  FILES  ♦ 

**************************************************************** 

INTEGER *4  GR I D , NODR  EC , LNKHEC , SUBREC 

COMMON  /LNKN0D/GRIDC128, 1 28) ,N0DREC(5, 100) ,LNKREC(5, 100) 

♦  , SUBREC l 500 ) 

***************************************************************** 
NXTLNKsLNKNUM 
LU= 3 

00  WHILE(NXTLNK.NE.O) 

CALL  GETNOXCNXTLNK, LKECNUM , RRDPOS ) 

CALL  GETREC(LU,LRECNUM,LNKREC) 

NsNRDPOS 

* 

♦  SET  LINK  TYPE  * 

TMPLINK  =  LIB$EXTZV(0, 16,LNKREC( 3,N)  ) 

CALL  LI BS I  NS VC TMPLINK, 0,1 6, LTYPE) 

* 

1F(LTYPE.LT.4)THEN 
LTYPES4-LTYPE 
TERMXY*LNKREC( 4, RRDPOS) 

CALL  NU02HX(TERMXY, HEXB) 


0058 

IF(HEXA.NE.HEXB)THFN 

0059 

CALL  HXRECDRLKHfc  XA,  HE;  6,  IADJ) 

0060 

1F(IADJ.E0.0)THFM 

0061 

♦ 

0062 

* 

SET  SUBNJDt  RECuRD  POINTER 

* 

0063 

THPLINK=LIH$EXTZV (0, 16,LNKREC(5, N) ) 

0064 

CALL  LlB$INSV(TMPLiNK,3, 16,SRECNUM) 

0065 

* 

SET  SUBNODE  WORD  POINTER 

* 

0066 

TMPLINK=LlB$EXTZV(16,16,LNKREC(5,N)) 

0067 

* 

CALL  L1B$INSV(T*PLINK,0,16,SUBhRD) 

0068 

* 

GET  TH£  SUBNODE  LIST 

* 

0069 

IF(SKECNUM.NE.O)THEN 

0070 

CALL  GETSUB(SRECNUM,SUBWRD,NUH) 

0071 

* 

PROCESS  THE  SUBNODE  LIST 

0072 

CALL  H£XSUB(HEXA,H£XB,NUM) 

0073 

ENDIF 

0074 

END  I F 

0075 

ENDIF 

0076 

ENDIF 

0077 

* 

GET  THE  NEXT  LINK  RECORD 

0078 

NXTLNK=LNKREC(2, WRDPOS) 

0079 

ENDDO 

0080 

return 

0081 

END 

00  0  1 

Guo. 


0i 
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Ob 
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1 

1 

1 

1 

1 

1 

1 

1 

1 


SJBROUTINc;  N0l>2HX(XY  , HS  TOR ) 

THIS  ROUTINE  UNPACKS  THE  X  AND  Y  COORD¬ 
INATES  FRjM  A  WORD  JF  THE  LOC  DATA  BASE, 
(FRUM  THE  NODE  OR  THE  EMMENDED  LINK  FILM 
AND  TRANSLATES  IT  TO  A  HEX  ADDkESS. 

INPUTS:  XY —  THE  PACKED  COORDINATES  * 

OUTPUTS:  HSTOR—  THE  INTERNAL  HEX  NUMBER  * 

*************************************************** 


IMPLICIT  INTEGER ( H , P ) 

INTEGFR*4  X Y , TMPNOD 

I NTEGER*2  X,Y 

include  #util:center.cmn' 

********************************************************** 

♦  THE  CENTER  OF  THE  HEX  GRID  IS  AT  XORIGIN , YORlGlN  * 

♦  WHERE  THE  COORDINATES  ARE  IN  METERS  UTM  RELATIVE  * 

♦  TO  A  GIVEN  GRID  ZONE,  * 

********************************************************** 


I NTEGER*4  XORIGIN, YORIGIN 

COMMON/ CENTER/X ORIGIN, Y0R1GIN 

DATA  XORIGlN/bOOOOO/,YORI GIN/5700000/ 

********************************************************** 


*  SET  X  COORDINATE  * 

TMPNOD=LIBSEXTZV(0,16,XY) 

CALL  LI8$1NSV(TMPN0D,0, 1 b , X ) 
XX=TRANX(X)-XJRIGIN 

*  SET  Y  COORDINATE 
rMPNOD=LIB$EXrZV(lb, lb,XY) 

CALL  LI»SINSV(TMPNOD,0,16,Y) 
YY=TRANY(Y)-Y0RIGIN 


LEV  =  4 

CALL  XYL2HACXX, YY, LEV, HSTOR) 

RETURN 

END 
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1  SUHKOUTI NE  NODEHEX(NUUE) 

2  *************************************************** 

3  *  This  ROUTINE  ACCESSES  THE  NODE  RECORD  ♦ 

*  FINDS  TriE  HEX  WHICH  CONTAINS  THE  NODE,  ♦ 

GETS  THE  LINK  POINTER  AND  PASSES  THIS  * 

POINTER  AND  THE  HEX  NUMBER  TO  L1NKHKX  * 

************************************************** 

*  INPUT:  NODE--  THE  HEAD  NODE  FOR  A  * 

*  GRID  RECORD  FROM  THE  * 

*  LOC  DATA  BASE  * 

*************************************************** 

12  IMPLICIT  INTEGER  (H,P) 

13  I NTEGER *4  WRDPOS 

14  INCLUDE  'UTIL:LNKNOD.CMN' 

15  1  ***************************************** ** ********************* 

lb  1  *  ARRAYS  FOR  THE  GR I D , NODE , LI NK , AND  SUBnODE  FILES  * 

17  1  **************************************************************** 

lb  1  I nTEGER ♦ 4  GRID,NODREC,LnKREC,SUBREC 

19  1  COMMON  /LNKNOD/GRID(128,128),NODREC(5,100J,LNKREC(5,100) 

20  1  ♦  , SUBREC ( 500 ) 

21  1  ***************************************************************** 

22  INCLUDE  'UTILiSUB.CMN' 

23  1  *********************************************************** 

24  1  *  SUBX , SUB Y  THE  X  AND  Y  COORDINATES  OF  THE  SUBNODES  * 

2b  1  *  IN  ONE  LInK  (SEE  BDM  DOCUMENTATION)  * 

2o  1  *********************************************************** 

27  1  I N TEGtR * 2  SUBX ( 1O0) , SUB  Y ( 100) 

28  1  COMMON/SUB/  SUBX,SUBY 

2y  |  ********************************************************** 

30  C 

31  DO  WHILE  (NODE.NE.O) 

32  CALL  GETNDX(NODE,NRECNUM,WRDPOS) 

33  LU=2 

34  CALL  GETREC(LU,NRECNUM,NODREC) 

3b  C 

3b  N0DXY=N0UREC(5,WRDP0S) 

37  CALL  N0D2HX( NODX Y , HEXA) 

38  LNKSN0DRECC4, WRDPOS) 

39  CALL  L1NKHEX(LNK,HEXA) 

40  C 

*  GET  NEXT  NODE 
NODE=NODREC( 1 , WRDPOS) 

ENDDO 

return 


PROGRAM  ROAOHEXER 

*♦****♦♦♦<*******♦*****»*****«***********♦»**♦****** 

*  T'l;;i  SET  JF  RJUTlNES  *AS  USED  TU  'HtXISE'  * 

*  lit-.  BOM-PRODUCED  LOC  DATA  FUR  GERMANY.  * 

*****♦♦*♦******♦*♦*♦*♦**********♦♦****#***♦********* 

IMPLICIT  1NTFGER(H,P) 

T .» TEGEK*4  XO,YO 

HCbUDE  'UTiL: CENTER. CMN' 

********************************************************** 

*  THE  CENTER  OF  THE  HEX  GRID  IS  AT  XORIGI N , YORI Gl N  * 

*  WHERE  THE  COORDINATES  AkE  IN  METERS  UTM  RELATIVE  * 

*  TO  A  GIVEN  GRID  ZONE.  * 

*******  ******************************** *******444*4  ******* 

INTEGER*4  XOR1GIN, YURlGIN 

C 1MMON/ CEN TLR/XOR I G1N,Y ORIGIN 

DATA  XOR 1 GIN /b 00 000/ , I  OR I GIN /570000U/ 

********************************************************** 

I  INCLUDE  'UTILsLNKNOD.CRN' 

**************************************************************** 

4  ARRAYS  FOR  THE  GRID, NODE, LINK, AND  SURnODE  FILES  * 

**************************************************************** 
INTEGER *4  GRID , NODREC , LNKREC , SUBREC 

COMMON  / LNKN0U/GR1D( 128, 128) , NODREC (5, 100) , LNKREC (5, 100) 

♦  ,  StJdREC ( 500 ) 

***************************************************************** 

* 

*  INITIALIZE  THE  HEX  PARAMETERS 

*  THE  VARIABLES  DLT  AND  DLN  IN  HEXINIT  MUST 

*  AGREE  WITH  THE  CENTER  COORDINATES  XORIGIN  AND 

*  Y ORIGIN  IN  CENTER. CMN 
CALL  HEXINIT 

4  OPEN  THE  LOC  AND  HEX  FILES 

CALL  OPENERS 

»  READ  IN  THE  GRID  POINTERS 

CALL  GRIDR 

4  XO  AND  YO  ARE  THE  RELATIVE  COORDINATES 

*  OF  THE  CENTER  OF  THE  AREA  TO  BE  ACCESSED 

4  THAT  IS,  XO  AND  TO  ARE  OFFSETS  IN  METERS 

4  FROM  THE  CENTER  OF  THE  HEX  GRID. 

PRINT4, 'ENTER  THE  COORDINATES  OF  THE  CENTER  OF  THE  ' 

PRINT*, 'AREA  TO  BE  PROCESSED  AS  METERS  FROM  THE  HEX  ORIGIN' 

READ* , X J, TO 

XUZXOKIGIN+XO 

YOsYORIGIN+YO 

4  SET  THE  GRID  POINTERS  FDR  THE  CENTER 

CALL  IGRIO(XO,YO,IO, JO) 

WRITE (6, 4 i 'NO*  ENTER  THE  LENGTH  OF  ONE  SIDE  OF  THE  SQUARE  A 
READ ( S . 4 ) IEXT 

IEXTslEXT/20  'DIVIDING  BY  2  AND  THEN  BY  10  (1/2  SIDE,10KM  R 
DO  l=10-IEXT,I0tlEXT,l 

DO  JsJ0-1EXT,JJ41EXT,1 
NODEsGkIDCI, J) 

CALL  NODEHEX(NODE) 

ENODO 

ENDDO 


I 
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SUBROUTINE  ADSCCM(  IGR  IDN  ,  CMER  1 D  ) 


N  A  N  E : 

ADSCCM  —  DETERMINE  Ct  NTKAL  MERIDIAN  OF  A  3RIDZ0NE 
PURPOSE : 

ro  CALCULATE  THE  CENTRAL  MERIDIAN  in  RADIANS  of 
A  GRIDZOnE  USING  the  INTEGER  GRID  NUMBER  (E.3  32  OF  '32 

description: 

AUTHOR  -  P.  *.  DENNIS 

LAST  MODIFIED  df  P.  *.  OENnIS  ON  08  JAN  aO 
MOD  LEVEL  DATE  DR  NUMBERS 

01  102979  DR  00009 


REAL 

PARA 

CJMPI 

CMERJ 


CALLING  SEQUENCE : 

CALL  ADSCCM  ( IGRIDN ,CM£RIDJ 
mHere: 

argument  name  pdl  data  name 


IGRIDN 


CMERID 


GRID.NUMBER 


CENT-MERID 


DESCRIPTION 


INTEGER  GRID  NUMBER 


CENTRAL  MERIDIAN 


OF  PROJECTION 


INPUT/JUTPUTj 

NONE 

RESTRICTIONS: 

NONE 

************ «****«♦****  ************************************** 
*8  CMERID 

ETER  PI*3. 141592654 
TE  CENTRAL  MERIDIAN 
D  s  DFl0TJCIGRIDN*6-183)*PI/180. 


RETURN 

End 


B-97 


0001 
0002 
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OoOb 
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0056 
005  7 


C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


iUdRJIUI  <£  AUSCDU(FDEG,  I  DEG,  IMTN,SEC) 

*******t ****************************************  ************** 
* 

*  NAME: 

*  ADSCdD  --  CONVERT  DECIMAL  DEGREES  TO  DEGKEES-M I NUTES-SE 

* 

*  PURPOSE: 

*  CONVERTS  DEGREES  TO  INTEGER  OEGREES  AND  MINUTES  AND  FLO 

*  POINT  S  ECONDS 

* 

*  description: 

*  AUTHOR  -  P.  A  .  DENNIS 

*  LAST  MODIFIED  8V  P.  E.  KING  ON  28  OCT  79 

*  MOD  LEVEL  DATE  DR  NUMBERS 

*  01  102979  DR  00009 


CALLING  SEQUENCE: 
CALL  AOSCOO  ( 
MHERE: 

ARGUMENT  NAME 

FOEG 

IOEG 

IM  IN 


,IDEG, ININ, SEC) 
PDL  DATA  NAME 
INP. DEGREES 
DEGREES 
MINUTES 


description 

F.P.  DEGREES 
INTEGER  DEGREES 
INTEGER  MINUTES 


sec 


seconds 


F.P.  SECONDS 


*  INPUT/UUTPUT: 

* 

*  NONE 

* 

*  RESTRICTIONS: 

*  NONE 

* 

**************************************  ************* 

COMPUTE  DEGREES  8T  TAKING  INTEGER  PART 

DEGREES  a  INTEGER  PART  OF  ABSOLUTE  VALUE  OF  [ INP.DEGREES J 
IDES  a  A3SCFUEG) 

GET  MINUTES 

MINUTES  =  (ABSOLUTE  VALUE  OF  ( I NP.DEGREESJ  MINUS  OEGREES  J  *  60 
IMIN  *  (AbS(FuEG)  -  IOEG)  *  60 
GET  SECONDS 

SECJNDS  a  (ABSOLUTE  VALUE  OF  ( INP.DEGREESJ  MINDS  DEGREES  MINUS  M I  NUT 
oOj  *  3600 


SEC  a  (ABS(FOfcG)  -  IOEG  -  FLOAT( IM IN ) /60 . )  *  3600. 
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I 


AuSCDU 


I 


p 

t 

OuSti 

C 

4 

0059 

c 

fWJuCAJE  TJ  .1  SECONDS 

4 

0060 

c 

• 

1 

0061 

SEC  =  A1N1 CS£C*10. )/l 0 

1 

0062 

c 

* 

00t>  J 

c 

'* 

0064 

R  E  T  J  ft  >'4 

4 

4 

0065 

E.D 

* 
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SJBKJuri.Ne:  ADSCr E(IGRION,  I  E  N  U  m  > 


OOOl 

0u02  C 

OOOJ  C 

0004  C 

0000  C 

OOOo  C 

0007  C 

oooa  c 

0009  C 

0010  c 

0011  C 

0012  C 

Ooli  C 

0014  C 

0015  C 

OOlo  C 

0017  C 

ooia  c 

0019  C 

0020  C 

0021  C 

0022  C 

0023  C 

0024  C 

0025  C 

0026  C 

0027  C 

0026  C 

0029  C 

0030  C 

0031  C 

0032  C 

0033  C 

0034  C 

0035  C 

0036  C 

0037  C 

0038  C 

0039  C 

0040  C 

0041  C 

0042  C 

0043  C 

0044  C 

0045  C 

•  004o  C 

0o4  7  C 

0048  C 

0049  C 

0050  C 

0051  C 

0052 

0053  C 

0054  C 

0055  C 

005o  C 

0057  C 


NAME: 

AOSCr’E  —  DETERMINE  THE  FIRST  100K  SQUARE  EAST 
UF  THE  CENTRAL  MERIDIAN 

purpjse: 

TO  DETERMINE  A  NUMBER  CORRESPONDING  TO  THE 

first  iook  square  east  of  the  central  meridian 
description: 

AUTHOR  -  P.  W •  DENNIS 

east  MODIFIED  BY  P.  R.  DENNIS  ON  7  JAN  80  j 

M3u  LEVEL  DATE  DR  NUMBERS 

01  102979  DR  00009 


CALLING  SEQUENCE : 

CALL  ADSCFS  (IGRIDN.IENUM) 

nhere: 

argument  name 


pdl  data  name 

INP.GRID.NUM 

CAST.100K.NUM 


DESCRIPTION 

A  GRID  NUMBER 

THE  NUMBER  CJRRESPOjjJ 
TO  THE  FIRST  EASTIN^ 
LETTER 

*1 


IGKIDN 
IENUM 

INPUT/aUTPUT: 

NONE 

RESTRICTIONS: 

NONE 

************************************************************* 


THE  EASTING  LETTER  ID  RANGES  FROM  'A-Z'  EXCLUDING  LETTERS  *L*  AND 
STARTING  NllH  'A*  AT  EVCRlf  THIRD  GRIDZONE  BEGINNING  WITH  GRXDZOnE 
l.E.  1,4, /, ...,38.  SO  FUR  GKIQZUNES  3 , 6 , 9 , . . . , 60 ,  THE  FIRST  IOOK 
SQUARE  EAST  JF  THE  CENTRAL  MERIDIAN  CAN  BE  REPRESENTED  BY  TrtE  2 1ST 
LETTER,  '*•}  FOR  GRIOZQnES  1 , 4 , 7 , . . . , 58 ,  THE  FIRST  IOOK  SQUARE  EAS— , 
OF  THE  CENTRAL  MERlDl AN  CAN  BE  REPRESENTED  BY  TrtE  5TH  LETTER, 

A  «D  FOR  GrtlDZJNES  2 , 5 , 8 , . . . , 59 ,  THE  FIRST  IOOK  SOUARE  EAST  UF  THE 
CENTRAL  MERIDIAN  CAN  BE  REPRESENTED  B1  THE  13TH  LETTER,  ' N ' 

...FIND  THE  REMAINDER  JF  INP.GRID.NUM  DIVIDED  BY  3 

IlsMOOUGHI  jN  ,  3  )  1 

CHECK  t' U  GR l nZUNE  NUMBERS  THAT  ARE  MULTIPLES  JF  3,  I . £. , GR I OZO  j 
1,6,9,..  ,m1 

IF  THE  REMAINDER  EQUALS  0 


0U5H  C 
0059 

0060  C 

0061  C 

0062  C 

0063 

0064  C 

0065  C 

0066  C 

0067  C 

0060  C 

0069  C 

0r07o 

0071  C 

0072  C 

0073  C 

0074 

0075  C 

0076  C 

0077  C 

0078  C 

0079 

0000  C 

0081  C 

0082  C 

0083 

0084  C 

0085 

0086 

0087 


LF  (il.EJ.O)  r.iE* 

6ET  EA3r.l00K.f4UM  EQUAL  TCI  21  (EAST  10  LETTER  'W') 

1ENJM  =  21 

CHECK  EUR  GKIDZJNE  NUMBERS  INCREMENTED  BY  3  STARTING  «irH  1  I  E 
GRIDZUNES  1,4,7,. ..,58 

ELSEIF  REMAINDER  EQUALS  1 

EliSElF  (  1 1 ,  E'J.  1 )  THEN 

SET  EAST.100K.nUM  EQUAL  TO  5  (EAST  ID  LETTER  'E') 

IENJM  =  5 

CHECK  FUR  GRIOZJNE  NUMBERS  INCREMENTED  BY  3  STARTING  nITH  2  I.E 
GRIDZONES  2,5,8,. ..,59 

ELSE 

SET  EAST.100K.nUM  EQUAL  TO  13  (EAST  ID  LETTER  'N') 

IENUM  =  13 

ENDIF 
H  E  T  U  R  N 
END 


SUBROUTINE  hDSCGLC  IGRIDL  ,  [  G  L  N  ,  IERFLG) 


ADSCGL  —  PERFORM  GR1DZONE  LETTER  TO  NUMBER  CONVERSION 
PURPOSE: 

TO  CONVERT  THE  GRIDZUNE  LETTER  TO  A  NUMBER  FROM 
-1U  TO  9  (0  THROUGH  9  NORTH  OF  EQUATOR) 

DESCRIPTION! 

AUTHOR  -  P.  W.  DENNIS 

LAST  MODIFIED  tii  P.  N.  DENNIS  ON  0 H  JAM  80 
MOD  LEVEL  DATE  DR  LUMBERS 

01  102979  DR  OOOU9 


CALLING  SEQUENCE: 

CALL  ADSCGL  ( IGR I DL , 1GLN , IERFLG) 

nhere: 

ARGUMENT  NAME  POL  DATA  NAME 


I GR I DL 


I  GLN 


IERFLG 


GR1D.LETTER 


GR1D.LETNUM 


ERK-FLAG-UCS 


DESCRIPTION 

THE  GRIDZONE  LETTER 

A  NUMBER  CORRESPOND 
TO  GRID.LETTER 

ERROR  FLAG  (-1  =  ER 


iNPur/ou  tput: 

NONE 

RESTRICTIONS: 

NONE 

**************************************************  ********* 


PARAMETER  ERROR  =  -I 


RITE  IGKIDL 


THE  FIRST  10  LETTERS,  'C-N',  REPRESENT  GRlDZONES  IN  THE  SOUTH 
HEMISPHERE.  #C'  «ILL  BE  REPRESENTED  bY  -10,  *D#  BY  -9,...,#M# 
THE  LAST  10  LETTERS,  *N-X#  REPRESENT  GRlDZONES  In  THE  NORTHER 
HEMISPHERE.  #N'  MILL  Bt  REPRESENTED  BY  0,  #P#  BY  1,  '3'  BY  2, 
,*k0  B1  9.  THESE  NUMBERS  *1LL  BE  USED  LATER  FOk  CALCULATING  T 
NOR TH  t  NG 


GRID.LETTER  GREATER  THAN  OR  EQUAL  TO  67  (ASCII  'C')  ? 


''.•'•/•.•'.•VvV..--..-’,-'  ■  •  ■  »* 
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005» 

IF  1  IGRIDL.  GE.67)  THEN 

0059 

C 

0060 

c 

GRID-LETTER  LESS  f HAN  OK  EQUAL  TO 

0061 

c 

0062 

IE  (IGRIDL.LE.88)  THEN 

0U6J 

c 

0064 

c 

GRID-LETTER  LESS  THAN  73  (ASCII  #I 

0065 

c 

0066 

• 

IE  ( IGR1DL . LT. 7 3 )  THEN 

0067 

c 

0068 

c 

SET  GR I D-LETNli  M  TO  GRID-LETTER  MINUS 

0069 

c 

0070 

I  jL  'J  s  IGRIDL  -  77 

0071 

c 

0072 

c 

ELSE  IS  GRID-LETTER  GREATER  THAN  73  ? 

0073 

c 

0074 

ELSEIF  (IGRIDL. GT. 73)  THEN 

0075 

c 

0076 

c 

GRID-LETTER  LESS  THAN  79  (ASCII  '0 

0077 

c 

0078 

IF  (IGRIDL.LT. 79)  THEN 

0079 

c 

0080 

c 

SET  GR I D-LETNUM  TO  GRID-LETTER  MINUS 

0081 

c 

0082 

I GLN  =  IGRIDL  -  78 

0083 

c 

0084 

c 

ELSEIF  GRIO-LETTER  IS- GREATER  THAN  79 

0085 

c 

0086 

ELSEIF  (IGRIDL. GT. 79)  THEN 

0087 

c 

0088 

c 

SET  GRID.LETNUM  TO  GRID-LETTER  MINUS 

0089 

c 

0090 

I GLN  =  IGRIDL  -  79 

0091 

c 

0092 

ELSE 

0093 

c 

0094 

c 

SET  ERR-FLAG-IJCS 

0095 

c 

0096 

IERFLG  s  ERROR 

0097 

c 

0098 

ENDIF 

0099 

ELSE 

0100 

c 

0101 

c 

SET  ERK-FLAG-UCS 

0102 

c 

•  0103 

IERFLG  s  ERROR 

0104 

c 

01-05 

ENOIF 

0106 

else 

0107 

c 

0108 

c 

SET  ERK-FLAG-UCS 

0109 

c 

0110 

IERFLG  s  ERROR 

0111 

r 

0112 

»OiF 

0113 

ELSE 

0114 

c 

n  i  no 
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0001 

0002  C 
OOOJ  C 

0004  C 

000b  C 

000b  C 

000/  C 

0o08  C 

0009  C 

0010  C 

Ooll  c 

0012  C 

OOli  C 

0014  C 

0015  C 

Oolo  C 

001  /  C 

0018  C 

0019  C 

0020  C 

0021  C 

0022  C 

0023  C 

0024  C 

0025  C 

Ou2b  C 

0027  C 

0028  C 

0029  C 

0030  C 

0031  C 

0032  C 

0033  C 

0034  C 

0035  C 

003b  C 

0037  C 

0038  C 

0039  C 

0040  C 

0041  C 

0042  C 

0043  C 

0044  C 

0045 

• 004o  C 

0047 

0048  C 

0049 

0050  C 

0051  C 

0052  C 

0053  C 

0054  C 

0055  C 

0050  C 

0057  C 


SUBROUTINE  A05C1E (LEAST,  IEMUM , IEAST ,  I  ERF LG ) 

**#«*«*t***********t*t*************************************** 

* 

*  fi  a  *1  e  : 

*  ADSCIE  —  COmPOTE  THE  EASTING  TO  THE  NEAREST  100  KiLOMt 

f  purpose:  : 

*  ro  compute  the  integer  easting  from  The  central,  mekidia1 

*  l’O  THE  NEAREST  100  KILOMETERS 

* 

*  INSCRIPTION! 

*  AUTHOR  -  P.  N.  DENNIS 

*  LAST  MODIFIED  BY  P.  *.  DENNIS  ON  08  JA 4  80  j 

*  MOD  LEVEL  DATE  DR  nUiBERS 

*  01  102979  DR  00009 


CALLING  SEQUENCE! 

CALL  ADSCIE  ( LEAST ,IENUM,IEAST,IEHFLG) 

nhere: 

ARGUMENT  NAME  POL  DATA  NAME  DESCRIPTION 

LEAST  EA5T_100K_LET  THE  EASTING  LETTER 

AN  MGR 


IENUM 

ieast 

IErFlG 


EAST.IOOK.nUM  THE  FInST  SQtf4'":5  EA1 

THE  CSNTRAL  HERIDIa: 

east.imt  integer  easting  in 

100  KM  UNITS 

ERR-FLAG-UCS  ERROR  FLAG  (-1  =  Eh 


♦  INPUT/OUTPUTs 

* 

*  NONE 

* 

*  restrictions: 

*  none 

* 

**********************************************  *********** 
PARAMETER  ERROR  S  -1 
BYTE  LEAST 

integer  *4  ieast 

TO  GET  the  EASTING  MEASURED  FROM  THE  CENTRAL  MERIDIAN,  DETERMINE 
NUMBER  CORRESPONDING  TO  THE  EAST  ID  LETTER  AND  SUdTwACT  THE 
NU.MbER  CORRESPONDING  TO  THE  EAST  ID  LETTER  OF  THE  FIRST  100K  SQU 
EAST  OF  THE  CENTRAL  MERIDIAN.  THEN  MULTIPLY  BY  100,000 


0058  C  IF  EAST. IOoK. LET  IS  GREATER  THAN  OK  EQUAL  TO  65  (ASCII  #A') 

0059  C 

0U60  IF  (LEAST.  GE. o5)THEN 

0061  C 

0062  C  IF  EAST-10 OK. LET  IS  LESS  THAN  OR  EQUAL  TJ  90  (ASCII  'Z') 

006  J  C 

0064  If  (LEAST. LE.90)THEN 

0065  C 

006o  ,  C  IF  EAST.100K.LET  IS  LESS  THAN  73  (ASCII  '!') 

0067  C 

OObb  IF  (LEAST. LE. 73)  THEN 

0069  C 

0070  C  SET  EAST. I N  T  TO  l  E AST.l OOK.LE f  MINUS  EAST. IOOK. NUM  MINUS  54  ]  *  10 

0o7 1  C 

0072  I  EAST  =  (LEAST  -  IENUM  -  64)  *100  000 

0073  C 

0074  C  ELSEIF  EASf.100K.LET  IS  GREATER  THAN  73 

0075  C 

007b  ELSEIF  (LEAST. GT. 73)  THEN 

0077  C 

0078  C  IF  EAST.100K.LET  IS  LESS  THAN  79  (ASCII  '0') 

0079  C 

0080  IF  (LEAST.LT. 79)  THEN 

0081  C 

0032  C  SET  EAST. IN T  TO  t  EASI.100K.LET  MINUS  EAST-100K.NUM  MINUS  65  1  *  1 

0083  C 

0084  IEAST  s  (LEAST  -  IENUM  -  65)  *100  000 

0OH5  C 

0086  C  ELSEIF  EAST-1 OOK.LET  IS  GREATER  THAN  79 

008 1  C 

0038  EuSElF  (LEAST. GT. 79)  THEN 

0089  C 

0o9u  C  SET  EAST. I N T  TO  l  EAST.l OOK.LE T  MINUS  EAST. IOOK. NUM  MINUS  66  J  *  l<] 

0091  C 

0092  IEAST  s  (LEAST  -  IENUM  -  66)  *100  000 

0093  C 

0u94  C  ELSE 

0095  C 

009b  ELSE 

0097  C 

0098  C  SET  ER R.FL AG.UCS 

0099  C 

0100  I  ERF LG  s  ERROR 

0101  C 

0102  C  ENOIF 

*  0103  C 

0104  ENOIF 

0105  C 

OlOo  C  ELSE 

0107  C 

0108  ELSE 

0109  C 

0110  C  SET  ERR-FL AG.UCS 

0111  C 

0112  IEHFLG  *  ERROR 

0113  C 

0114  C  ENOIF 
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e*oif 


ELSE 

ELSE 

SET  ERK.ELAG-UCS 
IERFLG  =  ERROR 
END  IF 

EiOlF 

ELSE 

ELSE 

SET  ERR.FLAG.UCS 
IERFLG  =  ERROR 
ENOIF 

ENDlF 

CHECK  FOR  EASTING  HLATANTLT  OUT  OF  RANGE 
(NO  EASTING  LETTER  SHOULD  HE  MORE  THAN  300  KM  FROM 
TtlE  CENTRAL  MERIDIAN  ) 

IF  ( IERFLG. ME. ERROR)  THEN 

IF  (IEA5T.3T.iOU  000  .OR.  IEAST.LT.-300  000)  THEN 

IERFLGsERROR 

EnOIF 

ENOIF 

RETURN 


SUBROUTINE  AObC  IN  (  IGLN,  I GR  I D  N  ,  N  1 OOK  N  ,  m(JR  TH  ,  ISpH  ER  ) 


i)001 


0002 

c 

0003 

r* 

♦♦MM********************************************************** 

0004 

C 

* 

0005 

c 

* 

name; 

000b 

c 

* 

A05CI9  --  COMPUTE  THE  NORTHING  TO  THE  NEAREST  100 

0007 

c 

* 

kilometers 

0008 

c 

* 

PUKPJSE: 

0009 

c 

* 

TJ  COMPUTE  THE  INTEGER  NORTHING  FROM  THE  E3UAXJR 

0010 

c 

* 

TO  THE  NEAREST  100  KILOMETERS 

0011 

c 

* 

0012 

c 

♦ 

description: 

0013 

c 

* 

AUTHJR  -  P.  a.  DENNIS 

0011 

* 

LAST  MODIFIED  BY  P.  *.  DEN  ft  IS  ON  08  JAN  80 

0015 

c 

* 

MOD  LEVEL  DATE  DR  NUMBERS 

001b 

c 

* 

01  102979  DR  00009 

0017 

c 

* 

0018 

c 

* 

0019 

c 

* 

CALLING  SEQUENCE : 

0020 

c 

* 

CALL  AOSCIN  ( IGLN , IGRIDM,N100KN , NORTH , ISPHER ) 

0021 

c 

* 

nhere: 

0022 

c 

* 

ARGUMENT  NAME  POL  DATA  NAME  DESCRIPTION 

0023 

c 

* 

0024 

c 

* 

IGLN  GRID.LETNUM  NUMBER  CORRESPONDS 

0u25 

c 

* 

THE  GRID20NE  LETTEk 

002o 

c 

* 

0027 

c 

* 

IGRION  INP-GRID.NUM  THE  NUMBER  OF  THE 

0028 

c 

* 

GRI OZONE 

0029 

c 

* 

N100KN  NORTH. 100K-NUM  THE  ft U  N B E R  CORRESPO 

0030 

c 

♦ 

100K  SQUARE  NORTHIN 

oun 

c 

* 

LETTER 

0032 

c 

* 

0033 

c 

* 

NORTH  NORTH. INT  INTEGER  NORTHING  IN 

0034 

c 

* 

100  KM  UNITS 

0035 

c 

* 

ISPHER  1NP. SPHEROID  SPHEROID  INDEX 

0036 

c 

* 

0037 

c 

« 

0038 

c 

* 

i npu i/ou  r put : 

0039 

c 

t 

0040 

c 

* 

NONE 

0041 

c 

* 

0042 

c 

* 

RESTRICTIONS; 

0043 

c 

« 

0044 

c 

* 

Cl)  THE  REFERENCE  GRIDZOftE  IS  IN  THE  SHARED  GLOBAL  AREA 

0045 

c 

* 

(2)  THE  MGR  INDEXED  SPHEROID  TABLE  IS  IN  THE 

004b 

c 

* 

SHARED  GLOBAL  AREA. 

0047 

c 

♦ 

0048 

c 

* 

0U49 

c 

************************************************************** 

0050 

c 

0051 

c 

0052 

INCLUDE  'ZD8PKO.COM' 

00100 

0053 

1 

C 

00200 

0054 

1 

c 

DUMMY  COMMON  ZD8PR0 

00300 

0055 

1 

c 

00400 

0056 

1 

INTEGER  *4  ZhFDAY,ZIDCnT,ZYD0G,ZTSECC4)  ,ZTEX(5) 

00500 

0057 

1 

INT£GER*2  ZSPHlD, ZYGOA  T. ZTSN , ZRGN  f ZRGL »  ZM3RSTC  3 , 3 ) , 2LLS T ( 5 

f 
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<>0600  0u58  1  L JGI CAL* 1  ZfSlC(3)  ,ZTU8N(25) 

1)0700  005  9  1  C 

00800  0060  1  C3«M3N  /ZDBPRO/  Z8FDAY , ZIDCNT, ZYDOG, ZTSEC, ZTEX , 

009u0  00b 1  1  2  ZSPHID,ZYGOAT,ZTSn  ,ZkG«  ,ZfSIC, 

01000  0062  1  3  Zl'DMN  ,  ZRGL  ,  ZMGRS I ,  ZLLS  f 

OlluO  0063  1  C 

0U64  C 

Ooba  PARAMETER  PI  s  3. 141593 

0066  C 

006/  C 

0068  C 

0069  C 

0070  INTEGER  *4  NDIST 

0071  INTEGER  *4  NORTH 

0072  INCLUDE  'ADSTAB.DAT' 

0073  1  C  ********************************************************* 

0074  1  C 

0075  1  C  TABLE  OF  SPHEROID  AXES 

0076  1  C 

0077  1  C  ********************************************************* 

0078  1  C 

0079  1  DIMENSION  AAXIS ( 9 ) , B AXIS! 9 ) 

0080  1  C 

0081  1  C  THE  SEMI-MAJOR  AXES 

0082  1  C 

0083  l  DATA  AAXIS  / 


0084 

1 

1 

6378388., 

• 

• 

INTERNATIONAL 

0085 

1 

2 

6378206., 

1 

• 

CLARKE  1866 

0086 

1 

3 

6378249., 

1 

• 

CLARKE  1880 

0u8  7 

1 

4 

6377276., 

1 

• 

EVEREST 

0088 

1 

5 

6377397., 

• 

• 

3ESSEL 

0089 

1 

6 

63781bO.  , 

« 

• 

AUSTRALIAN  NAT] 

0090 

1 

7 

6377397.  , 

1 

• 

AIRY 

0091 

1 

6 

6378155.  , 

• 

• 

FISCHER 

0092 

1 

9 

6377304.  / 

c 

• 

MALAYAN 

0093 

1 

c 

0094 

1 

c 

THE  SEMI-MINOR  AXES 

0095 

1 

c 

0096 

1 

OATA 

8AXIS  / 

0097 

1 

1 

6356912., 

1 

• 

INTERNATIONAL 

0096 

1 

2 

6356584. , 

t 

• 

CLARKE  1866 

0099 

1 

3 

6356515.  , 

f 

• 

CLARKE  1880 

0100 

1 

4 

6356075.  , 

1 

• 

EVEREST 

0101 

5 

6356079.  , 

• 

• 

bESSEL 

0102 

1 

0 

63567/5., 

1 

9 

AUSTRALIAN  N  AT J 

0103 

1 

7 

6356257., 

• 

• 

AIRY 

0104 

1 

8 

6356774., 

f 

• 

FISCHER 

0105 

1 

9 

6356102.  / 

• 

• 

MALAYAN 

0106 

1 

c 

0107 

1 

c 

0108 

1 

c 

MOD  LEVEL  DATE 

OR  NUMB! 

0109 

1 

c 

01  110979 

DR  OOOC 

0110 

1 

c 

0111 

1 

c 

0112 

1 

c 

LA 

L’  <nu  IFIED  BY  P.  E.  KING  ON  9 

NOVEMBER  79 

0113 

1 

c 

0114 

1 

c 
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0115 
0116 
on ; 
0116 
0119 
0120 
0121 
0122 
0123 
0124 
0125 
0126 
0127 
012B 
0129 
0130 
0131 
0132 
0133 
0134 
0135 
0136 
0137 
013B 
0139 
0140 
0141 
0142 
0143 
0144 
0145 
014b 
0147 
0148 
0149 
0150 
0151 
0152 
0153 
0154 
0155 
0156 
0157 
0158 
0159 
0160 
0161 
0162 
0163 
0164 
0165 
0166 
0167 
0168 
0169 
0170 
0171 


1  C 
1  c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


COMPUTE  APPROXIMATE  OISTANCE  USING  GR I O.LE IN JM 
uOkTH.uIST  =  SEMI_,MAJ*lGkID.LErNUM  *  8  ♦  4J  *  Pl.CONSi 
NOIST  =  AAXIS(ZSPHID)*(FL0AT(1GLN)*B.  ♦  4.)*PI/180. 

CALCULATE  TO  THE  NEAREST  2000  KILJMETERS 
iiORTn-lNT  a  2 1 000 , 000  *  INTEGER  PART  OF  (HJRTH.DIST  DIVIDED* 
NORTH  a  2  000  000  *  (NOIST  /2  000  000) 

ADD  ON  100  KILOMETER  PART 
NORTH. INT  a  NORTH. INT  ♦  100,000  *  nOkTH.100K.NUM 
NORTH  =  NORTH  4-  100  000  *  NlOOKN 
CHECK  FOR  TOO  FAR  NORTH 

IF  NORTH. INT  -  NORTH.D 1ST  IS  GREATER  THAN  1,500,000 
IF  (NORTH  -  NUlST  .GT.  1  500  000)  THEN 

SET  NORTH. IN T  TO  NORTH. INT  MINUS  2,000,000 
NORTH  a  NORTH  -  2  000  000 
OH  TOO  FAR  SOUTH 

ELSEIF  NORTH.DIST  -  NORTH. INT  IS  GREATER  THAN  1,500,0 
ELSEIF  ( NO  I  ST  -  NORTH  , GT.  1  500  000)  THEN 

SET  NORTH.I N  T  TO  NORTH. INT  PLUS  2,000,000 
NORTH  a  NORTH  ♦  2  000  000 

ENOIF 

MJW  CHECK  FOR  THE  1000  KILOMETER  JUMP  ACROSS  SPHEKOi 
IF  ABSOLUTE  VALUE  OF  (NORTH.INT  -  NORTH. OIST)  IS  GrEA 
GET  INDEX  TO  MGR  INQEXEU  SPHEROID  TABLE  i 
IRON  a  ‘IGRION  -  ZRGN  ♦  2 

-4ATCH  OUT  FOR  ZONES  1  AND  60 

IF  (IROn.EO.  -57  .OR.  IRON  .EQ.  61)  THEN 
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ENOIF 


IF  (IABS  (NOIST  -  NORTH) . G  T .  500  000)  THEN 
IF  NORTH. INT  IS  GREATER  THAN  NOR TH.D IS T 
IF  (NORTH  .GT.  NOIST )  THEN 

SET  NORTH. INT  TO  NORTH. INT  N1NUS  1,000,000 
NORTH  =  NORTH  -  1  000  000 

El.SE 

SET  NOKTH.IN T  TO  NORTH. INT  PLUS  1,000,000 
NORTH  s  NORTH  +  1  000  000 

ENOIF 

SET  INP. SPHEROID  TO  HIGH  BITE  OF  MGK.SPHERO ID.X  AB 
ISPHER  s  ZMGRST(IR0R,IGLN  -  ZRGL  ♦  2)/256 

ELSE 

SET  I Np. SPHEROID  TO  LON  BYTE  OF  MGR.SPHERO ID.TAB 

ISPHER  s  100  (ZflGRST(IRUR,IGLN  -  ZRGL  ♦  2),  256) 

ENOIF 

RETURN 
END 


R.nn 


SlIbROU  n  VE  ADSCLN  (  l.AT,LOnG,  NORTH,  It  AST,  IERFLG) 


OOOl 
0002 
OOOJ 
0004 
0005 
000b 
0007 
000b 
0009 
0010 
0011 
0012 
OOli 
001  1 
0015 
OOlb 
0017 
OOlb 
0019 
0020 
0021 
0022 
9023 
0024 
0025 
002b 
0027 
002b 
0029 
90  30 
0031 
0032 
0033 
0034 
0035 
003b 
0037 
003b 
0039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0047 
004b 
0049 
0050 
0051 
0052 
00100 
00200 
00300 
00400 
00500 


c 

n 

w 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


c 

c 

0053 

005* 

0055 

005b 

0057 


NAME: 

AOSCLN  —  LATL.ONG  TU  EASTI NG-NOrTHI NG  CONVERSION 
PURPOSE: 

fO  CONVERT  ASCII  LATITUDE  *ND  LONGITUDE  TO 
EASTINGS  AND  NORTHInGS. 


description: 

AUTHOR  -  P.  w.  DENNIS 
u AST  MODIFIED  SY  P.  w .  DENNIS  ON 
MOD  LEVEL  DATE 

01  102979 


08  JAN  « 0 
DR  NUMBERS 
OR  00009 


CALLING  SEQUENCE: 

CALL  AOSCLN  (LAT, LONG, NORTH, IEAST, IERFLG) 

NHERE: 

ARGUMENT  NAME  PDL  DATA  NAME  DESCRIPTION 


I  EAST 

EAST.LCS 

OTM  EASTING 

NORTH 

NORTH. LCS 

UTM  NORTHING 

IEKFLG 

ERK.FLAG.LCS 

ERROR  FLAG  (-1  = 

LAT 

LAT.LCS 

LATITUDE  (ASCII) 

LOn  G 

LONG.LCS 

LlHGITUDE  (ASCII) 

INPUT/QUTPUT: 

NONE 


*  RESTRICTIONS: 

* 

*  (1)  THE  REFERENCE  GRIDZUNE  IS  IN  THE  SGA  COMMON 

*  (2)  THE  REFERENCE  SPHERUID  IS  IN  THE  SGA  COMMON 
4 

t************************************************************' 

PARAMETER  PI  S  J.l4l592b54 

PARAMETER  0**0 
PARAMETER  ERROR  s  -1 


INCLUDE  'ZDbPRO.COM' 

1  C 

1  t*  DUMMY  COMMON  ZDBPRU 

1  C. 

1  I N  T  EGER  *  4  ZhFdAY,ZI0CNT,ZYD0G,ZTSEC(4) ,ZTEX(5) 

1  1NTEGeR*2  ZSPHID,ZYG0AT,ZTSN,ZRGN,ZKGL,ZMGRST(3, 33 ,ZLLST(5 


B-lll 


0U6O0 

00700 

008U0 

00900 

01000 

01100 


005  8  1 

0059  l 
0060  1 
0061  1 
0062  1 
0063  1 

0064 
0065 
0066 
0067 
0068 
0069 
00  7  J 
0071 
0072 
00  7  3 
0074 
0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
008a  C 
908o  C 
0087 
0046 
008  9 
0090 
0091 
0092 
0093 
0094 
0095 
0096 
0097 
0098 
0099 
0100 
0101 
0102 
0103 
0104 
0105 
OlOo 
0107 
0108 
0109  C 
0110  C 
0111 
0112 
0113 
OlU 


LJGiCALM  ZrSIC(3)  ,ZTDRN(25) 

COMMON  /ZUBPRO/  ZKFD  A  l ,  L I DCNT ,  Z  Y  DOG ,  Z  TSEC ,  Z  T  EX  , 

2  2SPHID,Z*G0AT,ZTSn  ,ZKGn  ,ZTS1C, 

3  ZTDRN  ,  ZRGL  ,  ZMGRST,  ZLLST 

BITE  LAT (2>,LUNG(2) , IrtEMIS 
ft£Ab*8  FLAT, FLUNG, CMERlU 

INTEGER  *4  NORTH, IEAST 

INTEGER  *2  IDEG, MIN 

INITIALIZE  ERR.FLAG-LCS  TO  'OK'  (=0) 

IERFLG=JK 

...CONVERT  ASCII  LAT/LONG  TO  FLOATING  POINT  RADIANS 


...FIRST  THE  LATITUDE 


...DECODE  LAT-LCS  INTO  THE  VARIABLES  DEGREES,  MINUTES,  .'-i 
...AND  HEMISPHERE 

UECOUE  CHARACTER  DATA  ACCORDING  TO  FORMAT  SPECIFICATI 

>  WRITE  (5,1)  L AT, LONG  1 

H  FORMAT  ('  LATs  ',9A1,'  LONG*  ',10A1)  ] 

OEC JOE  (9, 100l,LATfERK=9999)  IDEG , MIN , SEC, IHE M I S 
1001  FORMA  1  (2I2,F4.l,Al) 

CHECK  FOR  VALID  LIMITS  OF  LATITUDE  ^ 

IFdDEG.LT. 90  .AND.  MIN.LT.60  .AND.  SEC.LT.oO.)  THEN  j 

CONVERT  TO  RADIANS 

N 

'1 

FLAT  =  ( DFLOTI ( IDEG )  t  DFLOTI (MIN)/bO.  *  D8LE I  SEC ) /3600 . )  ^ 
IF  HEMISPHERE  IS  'S'  CHANGE  SIGN 
IF  (IHEMIS.EO.'S')  THEN 

SET  LAI.COORU  TO  NEGATIVE  LAT.COORD  | 

FLAT  =  -FLAT 

ELSE! F  HEMISPHERE  IS  NOT  'N'  SET  ERROR  FLAG 

ELSE1F  (IHEMIS.NE.'N')  THEN  B 

•  WRITE  (5,2) 

12  FORMAT  ('  ERROR  — HEMISPHERE  IS  NOT  NORTH') 

IERFLG  s  ERROR 

RETURN 

ENUlF 

t£LS&  § 
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D 

D  J 


Oil} 

Olio 

0117 

Olio 

01U 


01*6 

0157 

0153 

0159 

0160 

0161 

0162 

0163 

0164 

0165 

0166 

0167 

0160 

0169 

0170 

0171 


WRITE  (5,J) 

FORmAT  ('  DEG  IS  GT  90  JR  MIN  IS  GT  60  JR  SEC  IS  GT  60.') 
IERFLG  =  ERROR 
R  E  T  J  R  ft 
ESDlF 


0 

05 


C 

c 

c 

c 

c 

c 

c 

c 

c 


0120 

C 

J 

0121 

c 

...NUW  DO  LONGITUDE 

•; 

0122 

c 

0 1 2  J 

c 

...DECODE  LONG-LCS  InTO  THE  VARIABLES  jEGR EES, MINUTES 

_ 

0124 

c 

...AND  HEMISPHERE 

0125 

c 

; 

012a 

c 

DECODE  CHARACTER  DATA  ACCORDING  TO  FORMAT  SPECIFICAT1 

•_ 

0127 

c 

• 

012  3 

DECODE ( 10, 100  2,LONG,ERR  =  9999)  I DEG , MIN , SEC , I H £M  IS 

0129 

1002 

FORMAT  (I3,I2,F4.1,A1) 

a 

0130 

c 

1 

0131 

c 

CHECK  rOR  VALID  LONGITUDE  LIMITS 

.■ 

0132 

c 

V 

0133 

IF  (IDEG.LE.180  .AND.  MiN.LT.60  .AND.  SEC.LT.bO.)  THEN 

0134 

c 

0135 

c 

CONVERT  TO  RADIANS 

- 

0136 

c 

1 

0137 

FLONG  s  (DFL0TI(lDEG)+DFL0TICMIN)/6U.f  OBLE(SEC) /36u0. ) *PI 

i 

0133 

c 

0139 

c 

IF  HEMISPHERE  IS  '•*'  CHANGE  SIGN  OF  LONG 

0140 

0141 

c 

IF  CIHEMIS.EJ.'W')  THEN 

0142 

r» 

! 

0143 

c 

SET  LONG-COORD  TO  NEGATIVE  LUNG.COORD 

0144 

0143 

c 

FLJNG  s  -FLOnG 

•J 

0 1  4o 

c 

0147 

c 

ELSEIF  HEMISPHERE  IS  NOT  'E'  SET  ERROR  FLAG 

- 

0143 

c 

I 

0149 

ELSEIF  CIHEMIS.NE.'E')  THEM 

0150  C 

D 

WRITE  (5,4) 

0151  C 

D4 

FORMAT  ('  HEMISPHERE  IS  NOT  WEST') 

0152 

C 

0153 

IERFLG  s  ERROR 

2 

0154 

RETURN 

0155 

ENOIF 

1 

ELSE 

write  (3,5) 

FORMAT  ('  DEG  IS  GT  ISO  OR  MIN  IS  GT  60  OR  oEC  IS  GT  60.') 

IERFLG  =  ERROR 

RETURN 

ENOIF 

...HAVE  LAT/LQNG  IN  RADIANS,  NOW  PROJECT  IMTJ  CYLINDER 


DETERMINE.  1  HE  CENTRAL  MERIDIAN  OF  A  GRID2QNE(  REF-GRlD.q 
CALL  AOSCCM  (  7,>  GN  , CMERID) 

SET  SPHEROID  PARAMETERS! REF-SPHEROID) 
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0172  CALL  *DSSSPCZSPrtlD) 

017  3  C 

0174  C  PERFORM  UTM  PROJECTION 

017b  .  C 

0  1 7 o  CALL  ADSMP(FLaT#FLQM(I,CNERID#FEAST,FN3RTH) 

oi  /;  c 

0178  IEAST  S  FEAST 

017^  *JRTH  s  F nOrTM 

0180  C 

0181  RETURN 

0182  C 

0183  c  error  exit  for  decode 

0184  C 

0185  *999  IERFLG  =  ERROR 

018b  C  0  WRITE  ( b ,  6 ) 

0187  C  Ob  FJR^AT  ('  DECODE  ERROR') 

0188  RETURN 


SUBROUTINE  AO.aC<I(IGL»,IGKlDN,LNOHrH,  <  1 UOK  N  ,  I  ERFLG  ) 


* 


* 

* 

* 

t 

* 

* 

¥ 

* 

* 

¥ 

¥ 

* 

¥ 

* 

¥ 

* 

* 

* 

¥ 

¥ 

* 

¥ 

¥ 

¥ 

¥ 

¥ 

¥ 

¥ 

¥ 

¥ 

¥ 

¥ 

¥ 

¥ 

¥ 

♦ 


<A  ME: 

ADSCU  --  PERFORM  10UK  NORTHING  ID  LETTER  TO  I  *  TEGER 
NORTHING  CONVERSION 

PURPOSE: 

TO  CONVERT  THE  1QOK  NORTHING  ID  LETTER  TO  A 

NUMBER  KrtICH  CORRESPONDS  TO  THE  NUMBER  OF  100K  SQUARES 

FROM  THE  EQUATOR  (MODULO  2U) 

description: 

AUTHOR  -  P.  4,  DENNIS 

lj Ab T  MODIFIED  BY  P.  A.  DENNIS  ON  OR  JA  i  oO 
MOD  LEVEL  DATE  Dr  NUMBERS 

Oi  102979  DR  00009 


CALLING  SEQUENCE: 

CALL  ADSCNI  ( IGLN , IGRIDN , LNORTH , N 1 OOKN , I ERFLG ) 


-HERE: 

argument  name 

PDL  DATA  NAME 

DESCRIPTION 

IGRIOL 

GRID-LETTER 

THE  GK I d£ON £  LETTER 

IGLN 

GRID-LETNUM 

A  NUMBER  CORRESPOND 
TO  GRID-LETTER 

IEKFLG 

ERR-FLAG-UCS 

ERROR  FLAG  (-1  =  EK 

iNpur/uurpuT: 

NONE 

RESTRICTIONS: 

NONE 

¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥ 


PARAMETER  OK  sO 
PMRAMtTER  ERROR  s  -1 

BITE  LNORTH 

NORTHING  LETTER  IDS  GO  FROM  'A-V'  (NO  'I'  OR  '0')  AND  START  OVER 
iVERY  2,000,00u  METERS  (20  SQUARES).  IN  THt  NORTHERN  HEMISPHERE 
STARTING  AT  THE  EQUATOR ,  LETTERS  START  *ITH  'A'  FOR  THE  ODD  GRID 
.UlsOEKS  AND  NlfH  FUR  THE  EVEN  GRID  NUMBERS.  SO ,  FOR  ODD  GRID 

»U^ERS,  'A'  IS  REPRESENTED  BY  0,  'B'  BY  1,  *C*  BY  2 'V'  BY 
AND  “'OR  SVEN  GRID  NUMBERS,  #F#  IS  REPRESENTED  BY  0,  'G'  BY  1,  'H' 
*,...,  'V'  8 1  14,  ' A #  BY  15,...,  'E'  BY  19. 

IN  THE  SOU  THcRn  HEMISPHERE  STARTING  AT  THE  EQUATOR,  LETTER  START 
FRJ.M  V  AND  SO  BACK* ARDS  FOR  ODD  GRID  NUMBERS,  AND  FROM  E  AND  GO 


oACKhArOS  FOk  EVtN  GRID  NUMBERS.  SO,  FUR  ODD  GRIJ  NU4BERS,  'V'  IS  . 
REP  Rt.Sc:  .4  TEu  BY  -1,  'J'  6i  -2,  *T'  dY  -3,...,  'A'  61  -19,  AND  F  JR 
EVE.*  GRI  D  4UM3ERS,  '£'  IS  REPRESEN  TED  dY  -1,  'O'  81  -2,..,,  '  A '  d- 
'V'  uY  -o,...,  #  F  '  BY  -t9  fc 


IF  N  JR  TH.l UOK.LE  f  IS  GREATER  OR  EQUAL  TO  65  (ASCII  'A') 

IF  ( LnQR Td.GE.65)  THEN 

IF  NJRfH.lUOK.LEf  IS  LESS  THAN  OR  EQUAL  TO  8o  (ASCII  ' V ' ) 
IF  (LNORTH.bE.8o)  THEN 

IF  •*  JR  TH.l U OK. LET  IS  LESS  THAN  73  (ASCII  'l') 

IF  (LNURT-t.bT.7J)  THEN 


SET  NORTH. 100K.NUM  TO  NORTH. 1 OOK.LET  MINUS  65 
N 1  0  UK  it  s  bN  JR  TH  -  65 

ELSE  IF  NORTH. 100K.LET  IS  GREATER  THAN  7J 
ELSE  IF  (LMJRTH.GX.73)  THEN 

IF  NJRfH.lUOK.LET  IS  LESS  THAN  79  (ASCII  '□') 
IF  (LNORT-t.br. 79)  THEN 

SET  tOnT.t.lOOK .N U M  Td  NORTH.IOUK.LET  MINUS  6b 
N100KN  s  LN  JR  TH  -  66 

ELSE  IF  NORTH. 100K.LET  IS  GREATER  THAN  79 
ELSE  IF  (LNuRTH.GT.79)  THEN 


SET  JORTH.100K.NUM  TO  NOR TH. 1 OOK.LET  MINUS  6/ 
MIOOKN  s  bNJRTH  -  67 


ELSE 


SET  ERR-FL AG-UCS  TO  -l 


IERFLG  3  SRROr 

ENU  IF 
EMO  IF 


EbSE 


SET  ERR. FLAG. UCS  TO  -1 
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ItRFLG  =  ERRJH 


£  M  0  IF 
£<D  IF 

ELSE 

SET  ERR-fLAG-UCS  TO  -1 
IERFLG  =  -1 
EnD  IF 
ELSE 

SET  ERR.FLAG.UCS  TO  -1 
I C.RFLG  a  ERROR 
END  IF 

IF  ERR.FLAG.UCS  IS  'JK#  (aoj 
If  (IERFLG. EO. OK J  THEN 

IF  I  <P_.GRl  J.NUM  IS  EVEN 
IF  (MUD(IGRIDN,2J.EU.O)  THEN 

SET  NORTH. lOOK.NUM  TO  NOKTH-IOOK.NUM  MINUS  5 
N10JKM  a  NlOORN  -  5 

IF  NORTH. lOOK-NUM  IS  LESS  THAN  ZERO 
IF  (NlOOKN.ur.O)  THEN 

SET  NORTH. 100K.NUM  TO  NORTH-1 OOK.NUM  PLUS  20 
N100KN  a  NlOOKN  t  20 

E<0  IF 
EnD  IF 

IF  GRIl)_UETNUM  IS  LESS  THAN  ZERO 
IF  UGLN.Lr.0j  THEN 

SET  <ORTH.100K.NUH  TO  nQRTH.100K.NuM  MINUS  20 
MlOUKfJ  a  4 1 0 0 K N  -  20 
E  <0  IF 


ENU  IF 


0001 
0002 
0003 
0004 
0005 
0006 
0007 
OoO  b 
0009 
0010 
0011 
0012 
Ool  3 
0014 
0015 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
0023 
0024 
0025 
0026 
0027 
0028 
0029 
0030 
0031 
0032 
0033 
0034 
0035 
0036 
0037 
0038 
0039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
-0047 
0048 
0049 
0050 


SUBROUTINE  ADSCNL(nOKTH,IEAST,LAT,  LONG,  I  EH  F  l.G) 

*  ^^adscnl  --  easting-northing  to  latlong  conversion 

¥ 

f  PU  KP JSE J 

*  ro  CONVERT  EASTING  NORTHING  TO 

¥  ASCII  LATITUDE  AND  LONGITUDE 

* 

♦  DESCRIPTION: 

¥  AUTHOR  -  P.  *.  DENNIS 

♦  LAST  MODIFIED  BY  P.  N.  DENNIS  ON  Od  JAN  80 

♦  400  LEVEL  D^E  DR  NUMBERS 

,  01  102979  DR  00009 


CALLING  SEQUENCE: 

CALL  ADSCNL  ( NORTH , IfcAST, LAT , LONG, I ErFLG ) 

HFRE# 

ARGUMENT  name  PDL  DATA  NAME  DESCRIPTION 


,  1EAST  EAST-LCS  UTN  EA5TIN- 

*  NORTH  NORTH.LCS  UTM  NORTHING 

♦  IERFLG  ERR-FLAG-LCS  ERROR  FLAG  (-1  *  ER 

¥ 

I  uAr  LAT-LCS  latitude  (ASCII) 

♦  LONG  LONG..LCS  LONGITUDE  (ASCII) 

¥ 

¥  INPUT/OUTPUT: 

* 

¥  NONE 

♦  RESTRICTIONS: 

♦  (1)  THE  REFERENCE  GRIDZONE  IS  IN  THE  SGA  COMMON 

¥  (2)  THE  REFERENCE  SPHEROID  IS  IN  THE  SGA  COMMON 

¥ 

PARAMETER  PI  =  3,141592654 


UTN  EASTING 

utm  NORTHING 

ERROR  FLAG  (-1  *  ER 

LATITUDE  (ASCII) 
LONGITUDE  (ASCII) 


0051 

I NCLUUE 

00100 

0052 

1  c 

00200 

0053 

1  c 

00300 

0054 

l  c 

00400 

0055 

1 

00500 

0056 

1 

00600 

0057 

1 

DUMMY  common  zdbpro 

I  NTEGERM  ZrFDA*  ,ZIDCNT,ZYD0G,ZTSEC(4)  ,ZTEX(5) 

I N T EGER * 2  ZSPHI0,ZYG0AT,ZTSN,ZRGN,ZRGL,ZM3RST(3,3),ZLLST(5 

LOG! CALM  ZTSIC (  3 )  ,  ZTDMN  (  25 ) 
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m 

'.'-W 1  *  V*  -'I'l'.W*  -  v  . -  >  '•  •  . 

- - 

» 

• 

007U0 

0058 

1 

c 

’  « 

00800 

0059 

1 

COMMON  /Z08PR0/  ZRFDA  If ,  ZIDCNT ,  Zi  OQG ,  ZTSEC ,  Z  TEX  , 

-• 

00900 

0060 

l 

2  ZSPHID,ZYGOAT,ZTSN  ,ZRGN  ,ZTSIC, 

ft 

01000 

0061 

1 

3  ZIOwN  , ZRGL  , ZMGRS T , ZILS f 

V, 

* 

01100 

0062 

1 

c 

V 

0063 

BYTE  LA  T ( 1 ) #  L JNG ( 1  ) 

0064 

REAL*8  FLAT,FlONG,CM 

-• 

0065 

c 

-• 

■ 

0066 

I  NTEGER  *4  NORTH , I  EAST 

ft 

1 

0067 

c 

* 

0068 

FEAST  s  IEAST 

% 

0069 

FNORTH  -  NORTH 

*> 

0070 

c 

0071 

c 

...COMPUTE  THE  CENTRAL  MERIDIAN  OF  THE  REFERENCE  GRIDZ! 

i 

0072 

c 

DETERMINE  THE  CENTRAL  MERIDIAN  OF  A  GRID ZONE! REF.GRlD.rj 

1 

0073 

c 

0074 

CALL  ADSCCM(ZRGN,CM) 

r 

0075 

c 

■J 

0076 

c 

...NORMALIZE  TO  A  COMMON  PROJECTION  3Y  FINDING  THE 

LAT  : 

>. 

0077 

c 

...THROUGH  THE  INVERSE  UTM  PROJECTION 

* 

0078 

c 

SET  SPHEROID  PARAMETERS! REF. SPHEROID ) 

ft 

i 

0079 

c 

w 

.... , 

0080 

CALL  ADSSSP(ZSPHID) 

0081 

c 

♦ 

0082 

c 

PERFORM  INVERSE  UTM  PROJECTION 

»" 

0083 

c 

i 

0084 

CALL  AOSIMP (FEAST, FNORTH, CM, FLAT, FLQNG) 

m 

0085 

c 

1 

m 

0086 

c 

...CONVERT  FLOATING  POINT  RADIANS  TO  ASCII  DEG, MIN 

AND-. 

s 

0087 

c 

SET  LAT-COORO  EQUAL  TO  LAT.COORD  TIMES  180  DIVIDED 

by  ■; 

*4 

►< 

0088 

c 

ii 

0089 

FLAT  s  FLAT*! 30. /PI 

1 

0090 

c 

*•  - 

1 

0091 

c 

SET  LONG.COORD  EQUAL  TO  LONG.COORD  TIMES  180  DIVIDED  t»j 

' 

0092 

c 

- 

0093 

FLQNG  =  FLONG* 1 8 0 . /P I 

0094 

c 

Mil 

0095 

c 

...CONVERT  FROM  DECIMAL  TO  D,M,S 

K 

0096 

c 

CONVERT  DECIMAL  DEGREES  TO  DEGKEES-MINUTES-SECQNDS 

21 

0097 

c 

0098 

CALL  ADSCDDC FLAT, IDEG,MIN,SEC) 

JBll 

0099 

c 

' 

jfii 

0100 

c 

...PUT  VALUES  IN  LAT.LCS  USING  ENCODE 

0101 

c 

ENCODE  DATA  ACCORDING  TO  FORMAT  SPECIFICATION 

0102 

c 

* 

1 

0103 

ENCODE  (9, 1001 , L A T , ERR=9999 )  IDEG,MIN,SEC 

B. 

< 

■ 

• 

0104 

1001 

FORMAT  (212 ,F4. 1 ) 

• 

0105 

c 

« 

i 

0106 

c 

...SET  HEMISPHERE 

■ 

0107 

c 

SI 

0108 

c 

IF  SOUTHERN  HEMISPHERE 

i 

0109 

c 

m 

0110 

IF  (FLAT.LT.O.)  THEN 

m 

0111 

c 

SET  LAT-LCS(9)  TO  'S' 

M 

0112 

c 

m 

0113 

LAT(9)*'S' 

. 

s 

0114 

c 
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m 

ELSE  SET  LAT_LCS(9)  TO  '.M 


LAT(9)='N' 

ENDIF 

•  .  .NOW  00  LONGITUDE 

CONVERT  DECIMAL  DEGREES  TQ  DEGREES-MINUTES-SECONDS 

CALL  AOSCDD(FLONG,IDEG,MlN,SEC) 

...PUT  VALUES  IN  LONG.LCS  USING  encode  FUNCTION 

ENCODE  DATA  ACCORDING  TO  FORMAT  SPECIFICATION 

ENCODE  (9,1002, LONG, EKR=9999)  IDEG , Ml M , SEC 
1002  FORMAT  (I3,I2,F4.1) 

...SET  HEMISPHERE 
IF  WESTERN  HEMISPHERE 

IF  (FLONG.LT.O.)  THEN 

SET  LONG.LCS(IO)  TO  'W# 

L0NG(10)='W' 

ELSE  SET  LUNG-LCSC10)  TO  'E' 


ELSE 


L3N3(10)s'E' 

ENDIF 

DO  1000  I JKsl , 9 

IF  (LONG(IJK)  .EO.  '  ')  THEN 

LONGdJiOs'O' 

ENDIF  . 

IF  (LAT(IJK)  .EG.  '  #)  THEN 
LAT(IJK)='0' 

ENOIF 

1000  CONTINUE 
RETURN 

ERROR  EXIT  FOR  ENCOOE 


9999  lERFLGs-1 
RETURN 


00  01 

SUBROUTINE  ADSC'tUINORTH,  IEAST,MGR,  IERFLG)  1 

0002 

c 

0003 

c 

*****?***********«****«**«***************«****#**********«****  1 

0004 

c 

* 

0005 

c 

* 

NAME: 

0006 

c 

* 

ADSCNU  —  PERFORM  EASTI NG/NQRTHING  TO  MGk  CONVERSION 

0007 

c 

* 

0008 

c 

* 

PURPOSE: 

0009 

c 

* 

TO  CONVERT  AN  INTERNAL  FLOATING  POINT  EAST I N 3/ NOR TH I NG 

0010 

c 

* 

TO  AN  ASCII  MGR 

0011 

c 

* 

0012 

c 

« 

description: 

0013 

c 

* 

AUTHOR  -  P.  W.  DENNIS 

0014 

c 

* 

LAST  MODIFIED  BY  P.  « .  DENNIS  ON  08  JAN  80 

0015 

c 

* 

MOD  LEVEL  date  dr  numbers 

OOlb 

c 

* 

01  102979  DR  00009 

0017 

c 

* 

0018 

c 

* 

0019 

c 

* 

CALLING  SEQUENCE: 

0020 

c 

* 

CALL  ADSCNU  l NOR TH , IEAST , MGR , IERFLG) 

0021 

c 

* 

nhere: 

0022 

c 

* 

0023 

c 

* 

LEAST  EAST.UCS  UTM  EASTING 

0024 

c 

* 

002-5 

c 

* 

NORTH  NORTH. UCS  UTM  NORTHING 

002b 

c 

* 

0027 

c 

* 

MGR  UTM.UCS  ASCII  MGR  STHING 

0028 

c 

* 

0029 

c 

* 

0030 

c 

* 

0031 

c 

* 

IEHFLG  ERK.FL AG.UCS  ERROR  FLAG  (-1  =  ER  , 

0032 

c 

♦ 

0033 

c 

* 

INPUT/OUTPUT: 

0034 

c 

* 

0035 

c 

* 

NONE 

003b 

c 

* 

0037 

c 

* 

RESTRICTIONS: 

0038 

c 

* 

(1)  REFERENCE  GkIDZONE  IS  IN  SHARED  GLOBAL  AREA 

0039 

c 

* 

(2)  REFERENCE  SPHEROID  IS  IN  SHARED  GLOBAL  AREA 

0040 

c 

* 

i 

0041 

c 

**************************************************************  ] 

0042 

c 

0043 

PARAMETER  PI  S  3.141592654 

0044 

c 

0045 

c 

0046 

INCLUDE  'Z0dPH3.C0M'  K 

00100 

0047 

1 

C 

00200 

0048 

1 

c 

DUMMY  COMMON  ZU0PRO 

00300 

0049 

1 

c 

. 

00400 

0050 

1 

INTEGERM  ZRFDA  V  ,  ZIOCNT ,  ZYDOG,  ZTSEC (  4 )  ,  ZTEX  (  5 ) 

00500 

0051 

1 

INTEGER *2  ZSPHID,ZYG0AT,ZTSN,ZRGN,ZRGL,ZMGRST(3,3) ,  ZLLST(56; 

OObOO 

0052 

1 

LOGICAL*!  ZTSIC(3),ZTDWN(25)  j 

00700 

0053 

1 

c 

00800 

0054 

1 

COMMON  /Z08PR3/  ZRFDA T , ZIOCNT, ZY DOG, ZTSEC , Z  TEX , 

00900 

0055 

1 

2  ZSPHID,ZYGOAT,ZTSN  ,  ZRGN  ,ZTSIC, 

)l*'0  0 

0056 

1 

3  ZTDNN  , ZRGL  , ZMGRST , ZLLST 

01100 

0057 

1 

c 
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RYTE  MGK(2)  ,ALPHAC24) 


005a  C 

0059 

0060  C 

0061 

0062  C 

006  J 

0064  C 

0065  C 

0066  C 

0067 

0068 

0069 

0070  C 

0071 

0072 

0073  C 

0074  C 

0075  C 

0076  C 

0077 

0078  C 

0079  C 

0080-  C 

0081  C 

0082  C 

Oo  8  3  C 

0084  C 

0085  C 

0086 

0087  C 

0o8  8  C 

0089  C 

0090  C 

0091 

0092  C 

0093  C 

0094  C 

0095 

0096  C 

0097  C 

0098  C 

0099  C 

0100  C 

0101  C 

0102 

0103  C 

0104  C 

0105  C 

0106 

0107  C 

0108  C 

0109  C 

0110 

0111  C 

0112  C 

0113  C 

0114 


,i 


a 

REAL  *8  FLAT,FLQNG,CMERID 


INTEGER  *4  IE100,  NlOO,  NORTH,  IEAST  . 

SEX  ARRAY  ALPHA. CHAR  EOUAL  TO  LETTERS  'A-Z'  EXCLUDING  " 

< 

DATA  ALPHA  /  ' A ' , 'B # , 'C ' , ' D ' , ' E' , ' F ' , ' 3 ' , 'H  '  , 

2  'J','K', 'L#, 'M', 'N', 'P','3', 'R',  ' 

3  'S'/T','U'f'r,'<',')(','r,'Z'/  - 

FEAST  =  IEAST  - 

FNORTH  s  NORTH 

* 

COMPUTE  THE  CENTRAL  MERIDIAN  OF  THE  REFERENCE  GRIDZONEJ 
DETERMINE  THE  CENTRAL  MERIDIAN  OF  A  SRIDZONEC REF-GRID J 

CALL  ADSCCM  ( ZRGN , CMEK ID ) 

TO  FIND  THE  MGR  COORDINATE S,  THE  POINT  MUST  BE  NORMALIZij 
PROJECTION  BY  FINDING  THE  LATITUDE  AND  LONGITUDE  THEN  Pj 
A  CYLINDER  TO  GET  A  NEW  EASIING/NORTHING  ' 


SET  SPHEROID  PARAMETERS (REF.SPHEROID)  J 

CALL  AOSSSP(ZSPHID)  : 

PERFORM  INVERSE  UTM  PROJECTION  (EAST.UCS,  NORTH. UCS,  CENT.M6R 

LONG.COORDJ 

CALL  ADSIMP  ( FEAST , FNORTH , CMEHID , FLAT , FLONG ) 

, 

GET  SPHEROID  INDEX  FROM  LAT-LONG  INDEXED  SPHEROID  TABLE  ! 

CALL  ADSGSI  (FLAT,FLONG,ISPHER,NLORIG)  ! 

« 

COMPUTE  THE  GRID  NUMBER  OF  THE  INPUT  POINT 

M 

SET  INP.GRID.NUM  TO  INTEGER  PART  OF  [L0NS.CO0RDM80  DIVIDE^! 

♦  1861  DIVIDED  BY  6 

IGN  s  (FLONG4180./PI  ♦  186.1/6. 

IF  INP.GRID.NUM  IS  GREATER  THAN  60 

t 

IF  (IGN  .GT.  60)  THEN 

SET  INP.GRID.NUM  TO  INP.GRID.NUM  -  60 
IGN  s  IGN  -  60 

I 

ELSEIF  INP.GRID.NUM  IS  LESS  THAN  1 


ELSEIF  (IGN  .LT.  1)  THEN 


0115  C 

011b  C 

0117  C 

Olid 

0119  C 

0120 

0121  C 

0122  C 

0123  C 

0124  C 

0125  C 

0126 

0127  C 

0128  C 

0129  C 

0130 

0131  C 

0132  C 

0133  C 

0134 

0135  C 

0136  C 

0137  C 

0138  C 

0139  C 

0140  C 

0141 

0142  C 

0143  C 

0144  C 

0145  C 

0146  C 

0147  C 

0148 

0149  C 

0150  C 

0151  C 

0152  C 

0153 

0154  C 

0155  C 


SET  INP.GRID.NUM  TU  INP.GRID.NUM  *  60 
IGN  =  IGN  f  60 
E.MOIF 

IF  NOT  IN  REFERENCE  GRID  ZONE  OR  SPHEROID  TRANSFORM  TO 

IF  INP.SPHEROID  IS  NOT  REF.SPHEROID  OR  INP.GRID.NUM  IS  NOT 
IF  (ISPHER.NE.ZSPHIU  .OR.  IGN.NE.ZRGN)  THEN 

GET  ACTUAL  CENTRAL  MERIDIAN  FOR  INPUT  POINT 
CALL  AOSCCM(IGN,CMERID) 

SET  SPHEROID  PARAMETERS! INP.SPHEROID) 

CALL  AOSSSP(ISPHER) 

NOW  PROJECT  INTO  CORRECT  SPHEROID 


PERFORM  UTM  PROJECTION 
CALL  AOSMP  (FLAT, FLONG,CM£RID,CE AST, C NORTH) 

ROUND  TO  NEAREST  TEN  METERS 

SET  EASTING.NEW.COOKD  TO  10  TIMES  NEAREST  INTEGER  OFtEAST 

DIVI 

CEAST  s  10.*ANINTCCEAST/10.) 


SET  NORTHING .NEW .COORD  TO  10  TIMES  NEAREST  INTEGER  OFINORT 

DIVI 


CNORTH  s  10.*ANINT(CNQRTH/10.) 


0156  ELSE 

0157  C 

0158  C  SCI  EASTING. NEW.COORD  TO  EAST.UCS 

0159  C 

0160  CEAST  s  FEAST 

0161  C 

0162  C  SET  NORTHING. NEW. COORD  TO  NORTH.UCS 

0163  C 

0164  CNORTH  s  FNQRfH 


I 

I 

•1 

1 
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t 


0172 

C 

0173 

NDEX  =  C  FLATM  80. /PI  ♦  104.  )/8. 

*■* 

0174 

c 

0175 

c 

ACCOUNT  FUR  IRREGULAR  GRIDZONE  LABELED  BY  'X' 

-2 

017b 

c 

ft 

0177 

c 

IF  GRID. INDEX  IS  GREATER  THAN  22 

.** 

017  8 

c 

0170 

IF  ( NoEX.GT.22)  THEN 

!> 

0180 

c 

■•j 

0181 

c 

SET  GRID.INDEX  EUUAL  TO  22 

— 

0182 

c 

ft 

0183 

NDEX  =  22 

0184 

c 

.* 

0185 

c 

> 

018b 

ENDIF 

0187 

c 

0188 

c 

SET  GRID. LETTER  EQUAL  TO  ALPHA-CHAR  (GRID. INDEX) 

ft 

0189 

c 

0190 

ISLET  =  ALPHA ( NDEX ) 

0191 

c 

0192 

c 

DETERMINE  THE  100K  SQUARE  mITHIN  THE  GRIDZONE  IN  MHICH  THE 

POI^ 

0193 

c 

u 

0194 

c 

1 

0195 

c 

FIND  THE  FIRST  100K  SQUARE  EAST  OF  THE  CENTRAL  MERIDIAN  OF.; 

0196 

c 

0197 

c 

0198 

CALL  AOSCFE(IGN,IENUM) 

•  * 

0199 

c 

0200 

c 

FIND  THE  EASTING  ID  LETTER  BY  COUNTING  THE  NUMBER  OF  100K  SQW 

0201 

c 

THE  EASTING  COORDINATE  AND  ADDING  THIS  TO  THE  NUMBER  CORRESP  1 

0202 

c 

1ST  SQUARE  EAST  OF  THE  CENTRAL  MERIDIAN  TO  GET  AN  INDEX 

INTO  . 

0203 

c 

OF  LETTERS  REPRESENTING  THE  EASTING  ID  LETTER 

0204 

c 

0205 

c 

-4 

0206 

c 

SET  EAST. COUNT  EQUAL  TO  (INTEGER  PART  OF ( EASTING. NEW -COORD 

0207 

c 

0208 

IECNT  a  (CEAST  ♦  5.)  /100  000. 

0209 

c 

>1 

0210 

c 

IF  EASTING.NEW. COORD  IS  NEGATIVE 

0211 

c 

*1 

0212 

IF  (CEAST  .LT.  0.)  THEN 

fi 

0213 

c 

0214 

c 

DECREMENT  EAST-COUNT 

0215 

c 

0216 

IECNT  a  IECNT  -  1 

0217 

c 

0218 

EMDIF 

l 

0219 

c 

0220 

c 

SET  EAST-1 OOK-LET  TO  ALPHA-CHAR ( EAST-COUNT  ♦  EAST. 

1 0  0  K 

0221 

c 

'  , 

0222 

IELET  a  ALPHA ( IECNT  *  IENUM) 

0223 

c 

0224 

c 

FIND  THE  NORTHING  ID  LETTER  BY  COUNTING  THE  NUMBER  OF 

100| 

0225 

c 

THE  NORTHING  COORDINATE 

0226 

c 

-■ 

0227 

c 

0228 

c 

SET  NORTH-COUNT  TO  INTEGER  PART  OF  ( (NORTHING. NEN.COORD  * 

5J  /; 

8-125 

1 

• 

0229 
0230 
023  i 
02  32 
0233 
0234 
0235 
023b 
023/ 
0238 
0239 
0240 
0241 
0242 
0243 
0244 
0245 
0246 
0247 
0248 
0249 
0250 
0251 
0252 
0253 
0254 
0255 
0256 
0257 
0258 
0259 
0260 
0261 
0262 
0263 
0264 
0265 
0266 
0267 
0268 
0269 
0270 
0271 
0272 
0273 
0274 
0275 
027b 
027  7 
0278 
0279 
0280 
0281 
0292 
0283 
0284 
0285 


C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


N  C  V  T  =  (CNORTrt  ♦  5 .  ) / 100  000. 

SC  1'  N0RTH.C0UNT2  TO  NORTH.COUNT  j 

NCM  r2  =  NCN r 

IF  NORTHING-NEW .COORD  IS  LESS  f H AN  ZERO 
IF  CCNOKTH  .LT.  0.  )  THEN  j 

SET  N0RTH-C0UNT2  EQUAL  TO  99  *  N OR  IH.jCOU NT2 
NCNF2  =  99  ¥  N  C  N  T  2 

i 

END  IF 

DETERMINE  AN  INDEX  TO  THE  TABLE  OF  LETTERS  FOR  THE  NORTHl! 

SET  NORTH. INDEX  EQUAL  TO  ONE  PLUS  REMAINDER  OF  l [NORTH] 
NORTH.LErTER.DRIG]  DIVIDED  BY  20J 
NOEX  a  1  ♦  MOO ( NCNT2  ♦  NLURIG, 20 ) 

SET  NORTH.l 0 OK. LET  EQUAL  TO  ALPHA. CHAR  C NORTH.I NDEX )  j 
INLET  =  ALPHA(NDEX) 

FIND  EASTING  COORDINATE  WITHIN  THE  100K  SQUARE  BY  SUBTRACTING  \ 
UF  100,000  FROM  THE  EASTING  COORDINATE  j 

i 

SET  EAST.l OOK.COORD  EQUAL  TO  INTEGER  PART  OFCEASTING-NEW-C- 

EAST.COUNT*100,  OOOJ  DIVIDED: 

IE100  a  (CEAST  -  100  000 . * IECW D / 1 0 .  \ 

I 

FIND  MGR  NORTHING  COORDINATE  WITHIN  THE  100K  SQUARE  BY  SUB; 
MULTIPLES  OF  100,000  FROM  THE  NORTHING  COORDINATE 

SET  NORTH.l OOK.COORD  EQUAL  TO  INTEGER  PART  OFCnOKTHING; 
NORTH. COUNT* 1 00,000  J  DIVIDED  BY  10  g 

NtOO  »  (CNORTH  -  100  000.*NCNT)  /10. 

IF  NORTH.! OOK.COORD  IS  LESS  THAN  0 

IF  (N100  .LT.  0)  THEN  , 

SET  NORTH. 100K. COORD  EQUAL  TO  10,000  ♦  NORTH-i OOK.COOR; 

N 1 00  a  N 1 00  ♦  10  000 

1 
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0286 

0287 

C 

0288 

c 

0289 

c 

3290 

c 

0291 

c 

0292 

c 

0293 

c 

0294 

0295 

0296 

c 

0297 

0298 

1001 

0299 

1002 

0300 

0301 

0302 

c 

E^OIF 

EnCUDE  THE  COMPUTED  VALUES,  GRID.NUMBER,  GRID«jLETTER,  EAS 
NJRfH.100ri.LET,  E A ST_1 OOK.COQRD ,  AND  NORTH. 1 OOK.CJORD  INT 
13-CHARACTER  ASCII  STRING,  UTM.UCS 

ENCODE  DATA  ACCORDING  TO  FORMAT  SPECIFICATION 

EMCOOE  (5,1001,MGK(9))  NIOO-HO  OOO 
ENCODE  ( 5 , 1 00 1 , MGR ( 5 ) )  lElOOtlO  000 
FORMAT  (IS) 

ENCODE  (S, 1002, MGR)  IGN, IGLET, IELET, INLET 
FOR  4 A  T  (I2,A1,A1,A1) 


RETURN 

END 


■  '  "1 


00100 

0001 

SUBROUTINE  ADSCUN(MGRrlN,IE, IERFLG ) 

00200 

0002 

c 

00300 

0003 

c 

***********  **************************************  ****** 

004o0 

0004 

c 

* 

00500 

0005 

c 

*  name: 

00600 

0006 

c 

*  ADSCUN  --  PERFORM  MGR  TO  E  AS  T I  NG/N3R  TH I NG  CONVERi 

00700 

0007 

c 

* 

00800 

0006 

c 

♦  purpose: 

00900 

0009 

c 

*  TO  CONVERT  AN  ASCII  MGR  TO  INTERNAL 

01000 

0010 

c 

*  EASTING/NOR THING  FORMAT 

01100 

0011 

c 

♦ 

01200 

0012 

c 

*  DESCRIPTION: 

01300 

0013 

c 

*  AUTHOR  -  P.  *.  DENNIS 

01400 

0014 

c 

*  LAST  MOD I FI EO  BY  P.  4 .  DENNIS  ON  08  JAN  80 

01500 

0015 

c 

*  MOD  LEVEL  DATE  DR  NUMBERS 

01600 

0016 

c 

*  01  102979  DR  00009 

01700 

0017 

c 

* 

01800 

0018 

c 

* 

01900 

0019 

c 

*  CALLING  SEQUENCE: 

02000 

0020 

c 

♦  CALL  ADSCUN  C MGR , IN , IE , IERFLG ) 

02100 

0021 

c 

*  where: 

02200 

0022 

c 

*  ARGUMENT  NAME  PDL  DATA  NAME  DESCRIPTION 

02300 

0023 

c 

* 

02400 

0024 

c 

*  IE  EASTING  .COORD  JTM  EASTIN 

02500 

0025 

c 

♦ 

02600 

0026 

c 

*  IN  NORTHING.COORD  UTM  northing! 

02700 

0027 

c 

* 

02800 

0028 

c 

*  MGR  UTM.UCS  ASCII  MGR  ST 

02900 

0029 

c 

* 

03000 

0030 

c 

* 

03100 

0031 

c 

*  IERFLG  ERR.FLAG_.UCS  ERROR  FLAG  ( 

03200 

0032 

c 

* 

03300 

0033 

c 

*  INPUT/OUTPUT: 

03400 

0034 

C 

A 

* 

03500 

0035 

> 

*  NONE 

03600 

0036 

c 

03700 

0037 

c 

*  RESTRICTIONS: 

03800 

0038 

c 

* 

03900 

0039 

c 

*  (1)  REFERENCE  GRIDZONE  IS  IS  SHARED  GLOBAL  AREA 

04000 

0040 

c 

♦  (2)  THE  REFERENCE  SPHEROID  IS  IN  THE  SHARED  GLOBAL 

04100 

0041 

c 

* 

04200 

0042 

c 

******************************************************* 

04300 

0043 

c 

04400 

0044 

c 

04500 

0045 

INCLUDE  'ZDBPRO.COM' 

00100 

0046 

1 

c 

00200 

004/ 

1 

c 

DUMMY  COMMON  ZDBPRO 

00300 

0048 

1 

c 

00400 

0049 

1 

INTEGERM  ZRFDA i  ,  ZIOCNT,  Z YOOG,  ZTSEC(  4 )  ,  ZTEX (  5 ) 

00500 

0050 

1 

INTEGER *2  ZSPHID,ZYG0AT,ZTSN,ZRGM,ZRGL,ZMGRST(3, 3) ,ZLLST(56 

00600 

0051 

1 

LOGICAL* 1  ZTSIC(3)»ZTDWn(25) 

00700 

0052 

1 

c 

00800 

0053 

1 

COMMON  /ZDBPRO/  ZKFDA Y , ZIDCNT, ZYDOG , Z TSEC , ZTEX ,  • 

00900 

0054 

1 

2  ZSPHID,ZYGOAT,ZTSN  ,ZRGn  ,ZTSIC, 

01000 

0055 

1 

3  ZTDMN  , ZRGL  ,ZMGRST,ZLLST 

01100 

0056 

1 

c 

04600 

0057 

c 
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•'  **•’*-’  -  -  ■  •  ■/*  .* 

04700 

0058 

PARAMETER  OK  s  0 

048U0 

0059 

PARAMETER  ERROR  =  -1 

04900 

0060 

C 

05000 

0061 

R(TE  LNJRTH, LEAST, IGRIDL,MGR(2) 

05100 

0062 

c 

0S200 

0063 

REAL  *8  CMEKID, FLAT, FLONG 

053U0 

0064 

c 

05400 

0065 

integer  *4  north, ieast,nioo,ieioo, in, ie 

05500 

0066 

c 

05600 

0067 

c 

INITIALIZE  EKR.FLAG.UCS  TO  'UK'  (SOI 

05700 

0068 

c 

05800 

0069 

IERFLG  =  OK 

05900 

0070 

c 

06000 

0071 

c 

CONVERT  the  numeric  ascii  of  the  mgr  string  into  integer  f 

061 00 

0072 

c 

BV  OECUOING  THE  FIRST  2  CHARACTERS  INTO  INP.3R  ID.NUM ,  AND 

06200 

007  J 

c 

CHARACTERS  INTO  EAST.l OGK.COURD  AND  NORTH. 1 OOK .COORD  RESPE 

06300 

0074 

c 

06400 

0075 

DECODE! 13, 1001 , MGR , ERR=9999 ) IGRI DN , I GRI DL, LEAST, L NORTH, IE10 

06500 

0076 

1001  FORmAT(I2,3A1, 214) 

06600 

0077 

C 

• 

06700 

0078 

C 

CHECK  IF  WITHIN  UNE  GRID  NUM8ER 

06800 

0079 

C 

06900 

0080 

IDIF  =  IABS(ZRGN-IGRIDN) 

07000 

0081 

C 

07100 

0082 

IF  (IDIF  .GT.  1)  THEN 

07200 

0083 

C 

07300 

0084 

C 

REMEMBER  :  ZONES  1  AND  60  ARE  ADJACENT 

07400 

0085 

C 

07500 

0086 

IF  (IDIF  .NE.  59)  THEN 

07600 

0087 

IERFLG  s  ERROR 

07700 

0088 

RETURN 

07800 

0089 

EmDIF 

07900 

0090 

ENDIF 

0*000 

0091 

c 

08100 

0092 

c 

CONVERT  THE  3RD  CHARACTER  OF  THE  MGR  STRING  (GRIDZONE  LETTER) 

08200 

0093 

c 

GR I D.LETNUM ,  WHERE  A  POSITIVE  NUMBER  CORRESPONDS  TO  THE  NORTH 

08300 

0094 

c 

PHERE  AND  A  NEGATIVE  NUMBER  CORRESPONDS  TO  THE  SOUTHERN  HEM! £ 

08400 

0095 

c 

08500 

0096 

c 

08600 

0097 

c 

PERFORM  GRIDZONE  LETTER  TO  NUMBER  CONVERSION (GRID.LET1 

08700 

0098 

c 

ERR.FLAG. 

08800 

0099 

c 

08900 

0100 

CALL  ADSCGL(IGR10L,IGLN, IERFLG) 

09000 

0101 

c 

09100 

0102 

c 

IF  ERR.FLAG. DCS  IS  'OK'  (=0) 

09200 

0103 

c 

09300 

0104 

IF  (IERFLG. E3. OK)  THEN 

09400 

0105 

c 

09500 

0106 

c 

09600 

0107 

c 

CHECK  IF  WITHIN  ONE  GRID  LETTER 

09700 

0108 

c 

09800 

0109 

IF  (lABS(ZRGL-IGLN)  .GT.  1)  THEN 

09900 

0110 

IERFLG  s  ERROR 

10000 

0111 

RETURN 

10100 

0112 

ENDIF 

10200 

0113 

c 

10300 

0114 

c 

CONVERT  THE  5TH  CHARACTER  OF  THE  UTM  STRING  (100K  NORTHIf 
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1 04v ')  0115  C 

10500  011b  C 

10600  0117  C 

10700  0110  C 

lObOO  0119  C 

10900  0120 

11000  0121  C 

111^0  0122  C 

11200  0123  C 

11300  0124 

11400  0125  C 

11500  0126  C 

11600  0127  C 

11700  0128  C 

11800  0129  C 

11900  0130  C 

12000  0131 

12100  0132  C 

12200  0133  C 

12300  0134  C 

12400  0135  C 

12500  0136  C 

12600  0137  C 

12700  0138 

12000  0139  C 

12900  0140  C 

13000  0141  C 

13100  0142 

13200  0143  C 

13300  0144  C 

13400  0145 

13500  014b  C 

13600  0147  C 

13700  0148  C 

13800  0149  C 

13900  0150  C 

14000  0151  C 

14100  0152 

14200  0153  C 

14300  0154  C 

14400  0155  C 

14500  0156 

14600  0157  C 

14700  0158  C 

14800  0159  C 

14900  0160 

1*5000  ,  0161  C 

15100  0162  C 

15200  0163  C 

15300  0164  C 

15400  0165  C 

15500  0166 

15600  0167  C 

15700  0168  C 

15800  0169  C 

15900  0170  C 

16000  0171 


A  M  INTEGER  NORTHING,  uOR TH.l OOK.NUM 

PERFORM  100K  NORTHING  10  LETTER  TO  INTEGER  NORTHING  CO' 
(GKID-LErNUM,lNP.GRlD.NUM,  NORTH.IOOK.LET, N0RTH.100K.NU! 

CALL  AOSCNI(1GLN,IGRIDN,LNORTH,N100KN,IERFLG) 

, 

IF  ERR.FLAG.UCS  IS  'OK'  (sO) 

IF  (IERFLG.EQ.QK)  THEN  I 

...DETERMINE  A  NUMBER,  EAST.100K.NUM ,  CORRESPONDING  TO* 
...EAST  OF  TnE  CENTRAL  MERIDIAN  OF  THE  INPUT  GKIUZQNfc  ; 
DETERMINE  THE  FIRST  100K  SQUARE  EAST  OF  THE  CENTRAL  ME^ 
(InP_GkID.NUM,EAST.100K.NUM) 

CALL  AOSCFEdGRIUN,  IENUM) 

...COMPUTE  THE  EASTING,  EAST.INT,  MEASURED  FROM  THE  CE' 
...THE  INPUT  GRIDZONE,  TO  THE  NEAREST  100K 
COMPUTE  THE  EASTING  TO  THE  NEAREST  100  KILOMETERS/ 
(EAST. 100K. LET, E AST.l 0 OK. NUM,  EAST.INT, ERR.FLAG.UCS)  < 

CALL  AOSCIECLEAST, IENUM, IEAST, IERFLG) 

IF  EHR.FLAG-UCS  IS  'OK'  (sO)  | 

t 

IF  (IERFLG.EQ.OK)  THEN  4 

SET  EASTING-COORD  EQUAL  TO  EAST.INT  PLUS  EAS T.l OOK.COO 
CEAST  -  IEAST  ♦  10  *  IE100 

...COMPUTE  THE  NORTHING,  NORTH. INT,  MEASURED  FROM  THE  J 
...NEAREST  100K  I 

COMPUTE  THE  NORTHING  TO  THE  NEAREST  100  KILOMETERS/ 
(GRID.LETNUM,  I NP.GRIU.NUM,  NORTH.l OOK.NUM,  NOR  TH-INT,  INP;J 

CALL  ADSCIN(IGLN,IGRIDN,N100KN,N3RTH,ISPHER) 

IF  INP.SPHEROID  IS  NUT  ZERO  H 

IF  (ISPHER.NE.O)  'THEN 

SET  NOHTHIwG.COORD  EQUAL  TO  NORTH-INT  PLUS  N OR IH-1 OOK.  . 
CNORTH  s  NORTH  ♦  10  *  MOO  t 

IF  INP.GR ID— NUM  IS  NOT  EQUAL  TO  REF-3R ID-NUM  OR  INP.SP> 
NOT  EQUAL  TO  REF-SPHEROID 

IF  (IGRIDN.NE.ZRGN  .OR.  ISPHER . NC. ZSPHI 0 )  THEN  l 

...CUMPUTE  THE  CENTRAL  MERIDIAN  OF  THE  INPUT  GRIDZONE 
DETERMINE  THE  CENTRAL  MERIDIAN  OF  A  GRID ZO NEC INP.GR ID.. 

CALL  AOSCCM(IGRION,CMERID) 
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16100 

0172 

C 

l  6  2  0  0 

0173 

c 

...NORMALIZE  the  easting/northing,  eastinG-Cjokd  and  n- 

163U0 

0174 

c 

...COMMON  PROJECTION  87  CALCULATING  CHE  LA  T I TULE  AND  Li 

16400 

0175 

c 

...THEN  A  NEH  EASTING/NOHTHING. 

16500 

0176 

c 

16600 

0177 

c 

SET  SPHEROID  PARAMETERS  ( INP.SPHEROID)  , 

16700 

0178 

c 

16800 

0179 

CALL  ADSSSPI ISPHER1 

16900 

0180 

c 

17000 

0181 

c 

PERFORM  INVERSE  UTM  PRO JF.CTION  (  EAST I  NG-COORD ,  NORTHI NG- | 

17100 

0182 

c 

CENT..KER  ID,  LAT.COOKD,  LONG-COORD) 

17200 

0183 

c 

17300 

0184 

CALL  AoSIMPICEAST, CNORTH, CMERID, FLAT, FLONG) 

17400 

0185 

c 

17500 

0186 

c 

...COMPUTE  THE  CENTRAL  MERIDIAN  OF  THE  REFERENCE  GRIDZ, 

17600 

0187 

c 

DETERMINE  THE  CENTRAL  MERIDIAN  OF  A  JR 1DZ0NE ( REF-GR 1 D_ 

17700 

0188 

c 

17800 

0189 

CALL  ADSCCM(ZRGN,CMERID) 

17900 

0190 

c 

18000 

0191 

c 

SET  SPHEROID  PARAMETERS  (REF-SPHEROID) 

18100 

0192 

c 

18200 

0193 

CALL  AOSSSPC ZSPHID) 

18300 

0194 

c 

18400 

0195 

c 

PERFORM  UTM  PROJECTION (LAT-COORD,  LONG. COORD,  CENT-.MERID  : 

18500 

0196 

c 

EASTING-COORD, NORTHiNG-CQORD) 

18600 

0197 

c 

18700 

0198 

CALL  ADSMP(FLAT, FLUNG, CMER £ D , CEAST , CnORTH ) 

18800 

0199 

c 

18900 

0200 

ENDIF 

19000 

0201 

c 

19100 

0202 

c 

SET  EAST-UCS  EQUAL  TO  EAS T I NG-COORD 

19200 

0203 

c 

19300 

0204 

IE  =  CEAST 

19400 

0205 

c 

19500 

0206 

c 

v_-  SET  NORTH-UCS  EQUAL  TO  NORTHING-COORD 

19600 

0207 

c 

19700 

0208 

IN  s  CNORTH 

19800 

0209 

c 

19900 

0210 

ELSE 

20000 

0211 

c 

20100 

0212 

c 

SET  ERR-FLAG-UCS 

20200 

0213 

c 

* 

20300 

0214 

ierflg  s  error  : 

20400 

0215 

c 

20500 

0216 

ENDIF 

20600 

0217 

ENDIF 

20700 

0218 

ENDIF 

20800 

0219 

ENDIF 

20900 

0220 

RETURN 

21000 

0221 

c 

21100 

0222 

c 

ERRUR  EXIT  FOR  DECODE 

21200 

0223 

c 

2l3uO 

0224 

9999 

IERFLG  s  ERROR 

21400 

0225 

RETURN 

21500 

7226 

END 

1 

1 


1 


SUBKOUT I N  E  AOSGSI (FLAT,FLJNG, ISPHfcR,LNORIG) 

3002 

c 

0003 

c 

******4444444444444444444444444*4444444444444*4444444444444444 

0004 

c 

* 

0005 

c 

* 

NAME; 

0006 

c 

* 

ADSGSI  —  GET  SPHEROID  INDEX  FROM  LAT-LONG  INDEXED 

0007 

c 

* 

SPHEROID  TABLE 

0000 

c 

* 

0009 

c 

* 

PURPOSE! 

3010 

c 

* 

TO  DETERMINE  IN  rtHICH  SPHEROID  A  GIVEN  LAT-LONG 

0011 

c 

4 

IS  AND  TU  RETURN  THE  NORTHING  LETTER  ORIGIN 

0012 

c 

4 

0013 

c 

4 

DESCRIPTION: 

0014 

c 

* 

AUTHOR  -  P.  4.  DENNIS 

0015 

c 

* 

LAST  MODIFIED  BY  P.  4.  DENNIS  ON  08  JAN  80 

1 

0016 

c 

♦ 

MOO  LEVEL  DATE  DR  NUMBERS 

1 

0017 

c 

01  102979  OR  00009 

0018 

c 

* 

0019 

c 

* 

0020 

c 

4 

CALLING  SEQUENCE: 

0021 

c 

4 

CALL  AOSGSI  (FLAT, FLUNG, ISPHER , LNORIG) 

0022 

c 

4 

khere: 

0023 

c 

4 

ARGUMENT  NAME  PDL  DATA  NAME  DESCRIPTION 

0024 

c 

4 

' 

0025* 

c 

4 

i 

0026 

c 

4 

FLAT  LAT.COORD  LATITUDE  (RADIANS) 

■ 

0027 

c 

4 

0028 

c 

4 

FLONG  LONG.COORD  LONGITUDE  (RADIANS) 

0029 

c 

4 

■ 

0030 

c 

4 

ISPHER  SPHEROID. INDEX  INDEX  OF  SPHEROlO 

! 

0031 

c 

4 

0032 

c 

4 

NLURIG  NORTH.LETTER^ORIG  ORIGIN  OF  NORTHING 

■ 

0033 

c 

4 

LETTER 

0034 

c 

4 

0035 

c 

4 

INPUT/UUTPUT: 

( 

0036 

c 

4 

0037 

c 

4 

NONE 

\ 

' 

0038 

c 

4 

0039 

c 

4 

RESTRICTIONS: 

« 

0040 

c 

4 

THE  LAT-LUNG  INDEXED  SPHEROID  TABLE  MUST  RESIDE 

0041 

c 

4 

IN  THE  SGA 

0042 

c 

4 

. 

* 

0043 

c 

44444444444444444444444444444444444444444444444444444444444444 

0044 

c 

0045 

PARAMETER  pi  s  3.141592654 

0046 

c 

! 

0047 

INCLUDE  'ZDBPKO.COM' 

00100 

0048 

1 

C 

00200 

0049 

1 

c 

DUMMY  COMMON  ZDBPRO 

00300 

0050 

1 

c 

00400 

0051 

1 

INTEGER 4  4  ZRFDA Y , ZIDCNT , Z YDOG, ZTSEC (4),ZTEX(5) 

1 

00500 

0052 

1 

INTEGER 42  ZSPHID,ZYGOAT,ZTSN,ZRGN,ZRGL,ZMGRST( 3,3) ,ZLLST(56)< 

00600 

0053 

1 

LOGICAL* 1  ZTSIC(3) ,ZTDWN(25) 

00700 

0054 

1 

c 

00800 

0055 

1 

COMMON  /ZUBPRU/  ZKFDAY , ZIDCNT, Z YDOG, Z TSEC,  Z TKX  , 

• 

00900 

0056 

1 

2  ZSPH  ID ,  ZYGUAT ,  ZTSN  ,  ZRGN  ,ZTMC, 

01000 

0057 

1 

3  ZTDMN  ,ZRGL  , ZMGRST , ZLLST 

1 

H 
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OH  00 


0058  1  C 

0059  C 

0060  C 

0061  C 

0062  C 

0063  C 

0064 

0065  C 

0066  C 

0067  C 

0068 

0069  C 

0070  C 

0071  C 

0072  C 

0073  C 

0074  C 

0075  C 

007b  100 

0077 
0078 
0079 
0080 
0081 

0082  C 

008  3  C 

0084  C 

0085  C 

0086  C 

0087  C 

0088 

0089  C 

0090  C 

0091  C 

0092  C 

0093  C 

0094 

0095  C 

0096  C 

0097  C 

0098  C 

0099  C 

0100  C 

0101  200 

0102 
0103 
0104 
0105 
0106 

0107  C 

0108  C 

0109  C 

0110  C 

0111  C 

0112  C 

0113 

0114  C 


COVERT  RADIANS  TO  TENTHS  OF  DEGREES 

TENTH-DEGREES  =  1800.*LQnG_COORD  DIVIDED  BV  PI-CONST  \ 
TEND  =  1800. /PI  *  FLONG  ! 

ii 

SET  LONG. INDEX  TO  -1  | 

LONG  =  -1  ! 

DO  UNTIL  LL-SPHEROID.TABCLONG-INDEX)  IS  LESS  THAN  TENTH.' 
AND  TENTH-DEGREES  IS  LESS  THAN  OR  EQUAL  TO  LL.SP HERO ID—/ 

INCREMENT  LONG-INDEX  BY  THU  j 

CONTINUE  1 

LONG  =  LONG  +  2  \ 

FLO*  =  2LLSH  LONG) 

FUP  s  ZLLST ( LONG  +  2 )  j 

IF  (.NOT, (FLO*  . LT.  TEND  .AND.  TEND  .LE.  FUP))  ! 

1  GOTO  100  j 


j 

i 

« 

SET  LAT-INDEX  TO  LL-SPHEROID-TAB ( LONG— INDEX  PLUS  ONE)  -! 

j 

LAT  =  ZLLST ( LONG  ♦  1)  -  3  j 

CONVERT  RADIAN  LATITUDE  TO  TENTHS  OF  DEGREES 
TENTH-OEGREES  s  1 800 .  *LAT-COORD  DIVIDED  BY  PI-CONST  ! 
TEND  s  1800. /PI  *  FLAT 

DO  UNTIL  LL-SPHEKOID-TAB(LAT-INDEX)  IS  LESS  THAN  TENTH-,' 
TENTH-DEGREES  IS  LESS  THAN  OR  EQUAL  TO  LL-SPHEROID.TAB( j 

INCREMENT  LAT-INDEX  BY  THREE  ! 

CONTINUE  > 

LAT  s  LAT  ♦  3 

FLO*  s  ZLLST(LAT)  j 

FUP  =  ZLLSTC  LAI  +  3 )  | 

IF(. NOT. (FLOW  .LT.  TEND  .AND.  TEND  .LE.  FUP))  j 

1  GOTO  200 

i 

i 

I 

SET  SPHEROID-JHDEX  TO  LL-SPHEROI D-TAB ( LA T-INDEX  + 1  ) 

1 

ISPHEh  =  7.LLST( LAT  ♦  1) 
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0115  C 

0116  C 

0117 

Olid  C 

0119  C 

0120  C 

0121 

0122  C 

0123  C 

0124  C 

0125  C 

0126  C 

0127  C 

0128 
0129 
0130 


SET  NORTH.LETTER.OKIG  TO  LL_SPHEROID_.TAB( LA T.InD£X+2) 
LSORIG  s  ZLLSKLAT  ♦  2) 

IF  SPHEROID- IN I) EX  IS  NEGATIVE 
IF  CISPHEH  . L  T,  0)  THEN 

...SPHEROID  JUNCTIUN  NOT  ALONG  PARALLEL  OR  MERIDIAN 
...SO  NE  NEED  TO  INTERPOLATE  LINEARLY 

...  THIS  CAPABILITY  TO  BE  PROVIDED  LATER 

ENOIF 

RETURN 

END 


0001 

0002 

C 

0003 

c 

0004 

C 

0005 

C 

0006 

C 

0007 

c 

0008 

C 

0009 

c 

0010 

c 

0011 

c 

0012 

c 

001J 

c 

0014 

c 

0015 

c 

0016 

c 

0017 

c 

0018 

c 

0019 

c 

0020 

c 

0021 

c 

0022 

c 

0023 

c 

0024 

c 

0025. 

c 

0026 

c 

0027 

c 

0028 

c 

0029 

c 

0030 

c 

0031 

c 

0032 

c 

0033 

c 

0034  . 

c 

0035 

c 

0036 

c 

0037 

c 

0038 

c 

0039 

c 

0040 

c 

0041 

c 

0042 

c 

0043 

c 

0044 

c 

0045 

c 

0046 

00.47 

0048 

1 

c 

0049 

1 

c 

0050 

l 

0051 

1 

c 

0052 

1 

c 

005  3 

1 

c 

0054 

t 

c 

0055 

1 

c 

00*  > 

1 

c 

005/ 

1 

c 

SUttRCiUn  VE  AUSIMP(FEASf  ,  FNOR  l’H  ,  CMER  I D  ,  FLAT  ,  FLOHG  ) 

*«*«*****•**********************************************?****** 

* 

*  NAME: 

*  ADSIMP  --  PERFORM  INVERSE  UTM  PROJECTION 

* 

*  purpose: 

*  ro  project  the  input  utm  coordinates  into  the 

*  earth 

* 

*  description: 


AUTHOR  -  P.  *. 

DENNIS 

LAST  MODIFIED 

BY  P.  E.  KING  ON  5 

OCT  79 

MOD  LEVEL 

DA  TE 

DR  LUMBERS 

01 

102979 

DR  00009 

02 

120579 

DR  00089 

CALLING  SEQUENCE: 

CALL  AOSIMP  (FEAST, FNOKTH , CMER ID , 

FLAT, FL JNG) 

mHERE: 

ARGUMENT  NAME 

PDL  DATA  NAME 

DESCRIPTION 

FEAST 

EASTING-COORD 

UTM  EASTING 

fnorth 

NORTHING-COORD 

UTM  NORTHING 

CMERID 

CENT— MER ID 

CENTRAL  MERIDIAN 

OF  PROJECTION 

FLAT 

LA  T— COORD 

LATITUDE  (RADIANS) 

FLONG 

LONG— COORD 

LONGITUDE  (RADIANS) 

iNPur/ourPUT: 

NONE 

RESTRICTIONS: 

*  spheroid  parameters  must  be  set  in  common  adscear 

* 

t****************** ******************************************* 

PARAMETER  K0  =  . 9996 
INCLUDE  'ADCEAR.COM' 


common  /aoceah/lspher, axmaj, AXMIN, A,B,C,E2 
purpose: 

CONTAINS  SPHEROID  PARAMETERS 

MOD  LEVEL  DATE  OR  NUMBERS 

01  110979  DR  00009 
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58 
5* 

0060 
0061 
0062 
0063 
0064 
0065 
0066 
0067 
0068 
0069 
0070 
0071 
0072 
0073 
0074 
0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 
0092 
0093 
0094 
0095 
0096 
0097 
0098 
0099 
0100 
0101 
0102 
0103 
0104 
0105 
0106 


1 

c 

VARIABLE 

POL  DATA  NAME 

DESCRIPTION 

1 

c 

1 

c 

lSPHER 

LAST  SPHEROID  USED 

1 

c 

AXMAJ 

SEMI-MAJ 

SEMI-MAJOR  AXIS  OF 

1 

c 

CURRENT  SPHEROID 

1 

c 

AXM  l  N 

SEMI_M1N 

SEMI-MINOR  AXIS  OF 

1 

c 

CURRENT  SPHEROID 

1 

c 

A 

A 

1  ST  MERIDIONAL  ARC 

1 

c 

COEFFICIENT 

1 

c 

B 

B 

2  ND  MERIDIONAL  ARC 

1 

c 

COEFFICIENT 

1 

c 

c 

C 

3  RD  MERIDIONAL  ARC 

1 

c 

COEFFICIENT 

1 

c 

E2 

E2 

SPHEROID  ECCENTRICITY 

1 

c 

squared 

1 

c 

1 

c 

1 

c 

LAST 

MODIFIED  BY  P.  E. 

KING  ON  9  NOV  79 

1 

c 

*************************************************************** 

REAL48  PSI,BZ,KZ, KY, AOU AD , BQDB2 , CQU AD , X , Y , Z, HOOT, FLAT , FLOMG 
REAL  48  CMERIO 

WRITE  (5,4)  A,B,C,AXMAJ,AXMIN 

.COMPUTE  PSI  (THE  MERIDIONAL  ARC  PARAMETER ) 

PSl3(FN3RrH*B4DSINC2.4DBL£(FN0RTH/A))* 

!  C40SIN(4.40BLE(FN0RTH/A)))/A 

COMPUTE  SLOPES  AND  INTERCEPTS  OF  PROJECTION  RAY 


BZ  =  -  FEAST  /  ( 3 . *K0 ) 

K L  s  2.4  dZ  /  (  OBLE(AXMAJ) 
KY  2  OTAN  (  PSI  ) 


DCOS  (PSI)  ) 


..SOLVE  QUADRATIC  EQUATION  FOR  INTERSECTION  OF  PROJECTION  RAY 
..WITH  SPHERJIJ;  BUT  FIRST  CALCULATE  COEFFICIENTS. 


AJUAO  2  1+  K  Y*KY  4  KZ*KZ 
BJ0B2  s  KZ4bZ 

CJUAO  s  8Z4BZ  -  DBLE( AXMAJ)40BLE(AXMAJ) 

X  2  (  -B0DB2  4  OSURT  (  BQ0B2  4  BQDB2  -  AQUAD4CQU AD  ))  /  AQUAO 
Y  2  AXM I N 4K Y * ( X  /  AXMAJ ) 

Z  s  KZ  4  X  4  BZ 

RJOT  2  0S3RT  ( DBLE (AXMIN)4DBLE(AXMIN)  -  Y4Y) 

FLAT  2  0 A T A N 2  ( DBLE ( AXMAJ/ AXM IN )  4  Y  , ROOT  ) 

FLOMG  2  CMERIO  4  DASIN  (  -Z/ROOT  4  DBLE ( AXMIN/AXM A J ) ) 

RETURN 


llll 


I 


SUBROUTINE  ADSMP(FLAT,FLO:<G,CmERID,  EE  AST  ,F.MORTH) 

tt************************************************************ 

* 

*  NAME: 

*  ADSMP  —  PERFORM  UTM  PROJECTION 

* 

*  purpose: 

*  TO  PROJECT  THE  INPUT  LAT  AND  LONG  INTO  THE 

*  TRANSVERSE  PROJECTION  CYLINDER 

* 

*  description: 

*  AUTHOR  -  P.  R •  DENNIS 

*  LAST  MODIFIED  BY  P.  E.  KING  ON  28  OCT  19 

*  MOD  LEVEL  DATE  DR  NUMBERS 

*  01  102979  DR  00009 


CALLING  SEQUENCE: 

CALL  AOSMP  (FLAT, FLONG,CMERID, FEAST, FNORTH) 


* 

* 

* 

nhere: 

ARGUMENT  NAME 

PDL  DATA  NAME 

DESCRIPTION 

♦ 

Jr 

FEAST 

EAcTING-COORD 

UTM  CASTING 

♦ 

* 

* 

FNORTH 

NORTHING-COORD 

UTM  NORTHING 

♦ 

* 

CMERID 

CENT-MERID 

CENTRAL  MERIDIAN 

* 

* 

OF  PROJECTION 

* 

* 

FLAT 

LAT-COORD 

LATITUDE  (RADIANS) 

♦ 

* 

FLONG 

LONG— COORD 

LONGITUDE  (RADIANS) 

* 

* 

iNpur/ourPUT: 

♦ 

* 

NONE 

▼ 

♦ 

* 

* 

RESTRICTIONS: 

SPHEROID  PARAMETERS 

MUST  BE  SET  IN 

COMMON  AOSCEAR 

*******  **********************************  ******** *********** 
PARAMETER  KOr.9996 

REAL*8  SLA T, SDL JNG, CLAT, CDLONG, FLAT, FLONG,CMERlD, PSI 

INCLUDE  'AOCEAR.COM' 

COMMON 

/ADCEAR/LSPHER, AXMAJ, 

AXMIN, A,B,C,E2 

• 

PURPOSE: 

CONTAINS  SPHEROIU  PARAMETERS 

MOO  LEVEt 
01 


DATE 

110979 


DR  NUMBERS 
DR  00009 


5b 


0059 

1 

C 

VARIABLE 

pdl  DATA 

NAME 

DESCRIPTI JN 

0060 

1 

C 

0061 

1 

C 

LSPHER 

LAST  SPHEROID  USED 

0062 

1 

C 

AXMA  J 

semi-maj 

SEMI-MAJOR  AXIS  OF 

0063 

1 

c 

CURRENT  SPHEROID 

0064 

1 

c 

AXMIN 

SEMI-MIN 

SEMI-MINOR  AXIS  OF 

0065 

1 

c 

CURRENT  SPHEROID 

0066 

1 

c 

A 

A 

1  ST  MERIDIONAL  ARC 

0067 

1 

c 

COEFFICIENT 

0068 

1 

c 

B 

a 

2  NO  MERIDIONAL  ARC 

0069 

1 

c 

coefficient 

0070 

1 

c 

C 

c 

3  RD  MERIDIONAL  ARC 

0071 

1 

c 

COEFFICIENT 

0072 

1 

c 

E2 

£2 

SPHEROID  ECCENTRICITY 

0073 

1 

c 

SQUARED 

0074 

1 

c 

0075 

1 

c 

0076 

1 

c 

LAST 

MODIFIED  BY 

P.  E. 

KING  ON  9  NOV  79 

0077 

1 

c 

t************************************************************** 

0078  C 

0079  C 

0080  C... .COMPUTE  TRIG  FUNCTIONS  ONCE  A  NO  SAVE! 

0081  C 

0082-  CLAT  =  DC3S  (FLAT) 

0083  SLAT  s  US  I N  ( FLAT ) 

0084  CUL3NG  s  UC3S  ( FLONG  -  CMERIO)  **• 

0085  S'JLONG  =  OSIN  (FLUNG  -  CMERIO) 

008b  C 

0087  C... .COMPUTE  PSI  L  THE  MERIDIONAL  ARC  PARAMETER) 

0088  C 

0089  PSI=0ATAN2(DdLE( AXMIN)*SLAT,DaLE( AXMAJ)*CLAT*CDLONG) 

0090  C 

0091  C... .COMPUTE  MERIDIONAL  ARC  (THE  NORTHlnGJ 

0092  C....MOKTHlNG-COaKO  s  A-*PSI  -  B-*SIN  C  2*PSI  J  -  C-.*SIM  l  4*PSI  ) 
0093  C 

0094  FNORTH=DBLE(A)*PSI  -  OBLE ( B ) *DSIN ( 2 . *PSI )  -  C*DSI N ( 4 . *PSI ) 

00.95  C 

0096  C... .COMPUTE  EASTING 

0097  C 

0098  C. . . .EASTING. CO 3RD  =  13*K0*SEMI.MA J*SDLONG*CLAT J  DIVIDED  BY 

0099  C... l2*SaUARE  ROOT  OF  (CLAT*CLAT* COLONG*COLONGt ( 1-E21 *SLA T*SLATJ  ♦  / 

0100  C... .SQUARE  ROOT  OF  t 1 -E2 *SLA T*SLA T J 1 

0101  C 

0102  FEASTs(3.*K0*DBLE(AXMAJ)*SDL0NG*CLAT)  / 

0103  !  (2.*0SQRT(CLAr*CLAT*CUL0NG*CDL0NG+(l-£2)*SLAT*SLAr  ) 

0104  !  ♦  0SqRT(1-E2*SLAT*SLAT)) 

0105  RETURN 


0001 

0002  C 

0003  C 

0004  C 

0005  C 

0006  C 

0007  C 

0008  C 

0009  C 

0010  C 

0011  C 

0012  C 

0013  C 

.0014  C 

0015  C 

OOlb  C 

0017  C 

0016  C 

0019  C 

0020  C 

0021  C 

0022  C 

0023  C 

0024  C 

0025  C 

0026  C 

0027  C 

0028  C 

0029  C 

0030  C 

0031  C 

0032  C 

0033  C 

0034  C 

0035  C 

0036  C 

0037 
0038 

0039  1  C 

0040  1  C 

0041  1 

0042  1  C 

0043  1  C 

0044  1  C 

0045  1  C 

0046  1  C 

0047  1  C 

0048  1  C 

0049  1  C 

0050  1  C 

0051  1  C 

0052  1  C 

0053  1  C 

0054  1  C 

0055  1  C 

0056  1  C 

0057  l  C 


SUBROUTINE  AOSiSP( ISPHER} 

t************************************************************* 

* 

*  NAME: 

*  AOSSSP  --  SETS  SPHEROID  PARAMETERS  1.4  COMMON  ADCEAK 

* 

*  PURPOSE: 

*  l’O  COMPUTE  MERIDIONAL.  ARC  PARAMETERS  AnD  SoUARED 

*  ECCENTRICITY  OF  THE  SPHEROID  SPECIFIED  BY  ISPHER 

* 

*  DESCRIPTION! 

*  AUTHOR  -  P.  N.  DENNIS 

*  LAST  MUDIFIED  BY  P.  E.  KING  UN  4  DEC  19 

*  MOD  LEVEL  DATE  DR  NUMBERS 

*  01  102979  DR  00009 

*  02  120479  DR  00064 


CALLING  SEQUENCE: 

CALL  ADSSSP  (ISPHER) 

mhere : 

ARGUMENT  NAME  PDL  DATA  NAME  DESCRIPTION 

ISPHER  INP.SPHEHOID  SPHEROID  INDEX 


*  INPUT/UUl'PUTj 

* 

*  NONt 

* 

*  RESTRICTIONS: 

*  NONE 

* 

************************************************************** 

PARAMETER  Kqs.9996 
include  'adcear.com' 


COMMON  /ADCEAR/bSPHER, AXMAJ, AXMIN, A,B,C, E2 

purpose: 

CONTAINS  SPHEROID  PARAMETERS 


MOO  LEVEL  DATE  DR  NUMBERS 

01  110979  DR  00009 


VARIABLE 


PDL  DATA  NAME 


DESCRIPTION 


LSPHEK 

AXMAJ 

AXMIN 


SEMI.MAJ 


SEMI.MIN 


LAST  SPHEROID  USED 
SEMI-MAJOR  AXIS  OF 
CURRENT  SPHEROID 
SEMI-MINOR  AXIS  OF 
CURRENT  SPHEROID 
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0050 

1 

C 

A 

A 

1  ST  MERIDIONAL  arc 

0059 

1 

c 

CQEFF IC1 E *T 

Oooo 

i 

c 

b 

3 

2  NO  MERIDIONAL  ARC 

0061 

1 

c 

COEFFICIENT 

0062 

1 

c 

c 

C 

3  RD  MERIDIONAL  ARC 

0063 

l 

c 

COEFFICIENT 

0064 

1 

c 

E2 

E2 

SPHEROID  ECCENTRICITY 

0065 

1 

c 

SQUARED 

0066 

1 

c 

0067 

1 

c 

0068 

1 

c 

LAST  MODIFIED  BY  P.  E . 

KING  ON  9  NOV  79 

0069  1  C  *************************************************************** 

0070  INCLUDE  'A0STAB.DAT' 


0071 

1 

c 

********************************************************* 

0072 

1 

c 

0073 

1 

c 

TABLE  JF  SPHEROID  AXES 

0074 

1 

c 

0075 

1 

c 

********************************************************* 

0076 

1 

c 

0077 

1 

DIMENSION  AAXISC9) ,BAXIS(9) 

0078 

1 

c 

0079 

1 

c 

the 

SEMI-MAJOR  AXES 

0080 

1 

c 

0081 

1 

DATA  A AX  IS  / 

0082 

1 

1 

6378388. , 

•  INTERNATIONAL 

0083 

1 

2 

6378206. , 

!  CLARKE  i860 

0084 

1 

3 

6378249. , 

•  CLARKE  1880 

0085 

1 

% 

6377276., 

!  EVEREST 

0086 

1 

5 

6377397., 

!  BESSEL 

0087 

1 

b 

6378160., 

!  AUSTRALIAN  NATIONAL 

0088 

1 

7 

6377397., 

!  AIRY 

0089 

1 

8 

6378155., 

!  FISCHER 

0090 

1 

9 

6377304.  / 

!  MALAYAN 

0091 

1 

c 

0092 

1 

c 

THE 

SEMI-MINOR  AXES 

0093 

1 

c 

0094 

1 

DATA  BAXIS  / 

.0095 

1 

1 

6356912. , 

!  INTERNATIONAL 

*0096 

1 

2 

6356584. , 

!  CLARKE  1866 

0097 

1 

3 

6356515., 

•  CLARKE  1880 

0098 

1 

4 

6356075.  , 

!  EVEREST 

0099 

1 

5 

6356079.  , 

!  BESSEL 

0100 

1 

6 

6356775.  , 

!  AUSTRALIAN  NATIONAL 

oioi 

1 

7 

6356257. , 

•  AIRY 

0102 

1 

8 

6356774., 

!  FISCHER 

0103 

1 

9 

6356102.  / 

•  MALAYAN 

01-04 

1 

c 

0105 

1 

c 

0106 

1 

c 

MOO  LEVEL 

DATE 

DR  NUMBERS 

0107 

1 

c 

01 

110979 

OR  00009 

0108 

1 

c 

0109 

1 

c 

0110 

1 

c 

LAST  MOOIFIED  BY  P. 

E.  KING  ON  9  NOVEMBER  79 

0111 

1 

c 

0112 

1 

c 

0113 

1 

c 

I'tH****  ******************************************************* 

0114 

1 

c 

********************************************************* 
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Oils  c 

oiu  c 

0117  C  THE  FULLOw ING  'IF  TEST*  SHOULD  bE  PERFORMED 

Olid  C  I  i  FUTURE  IMPLEMENTATIONS  IN  ORDER  TO  AVOID 

0119  C  PERFORMING  CALCULATIONS  WHICH  WILL  HE  REDUNDANT 

0120  C  F JR  A  MAJORITY  OF  OCCURENCES 

0121  C 

0122  C  IF  I NP. SPHEROID  IS  NOT  EQUAL  TO  SPHEROID.lNDEX 

012  J  C 

0124  C  SET  SPHEROID-INDEX  E DUAL  TO  INP.SPHERQID 

01 2S  LSP HER  s  ISPHtR 

0126  C  0  WRITE  (5,*)  'SET  PARAMETERS  FUR  SPHEROID  ' , LSPHER 

0127  C  SET  SEMI.MAJ  BY  PERFORMING  TABLE  LOOK-UP  INTO  SPHEROID-TAB 

0120  AXMAJ  s  AAXISC LSPHER) 

*0129  C 

0130  C  SET  SEMI. MIN  BY  PERFORMING  TANLE  LOOK-UP  INTO  SPHEROID. TAB 

0131  C 

0132  AXMIN  a  BAXIS(LSPHER) 

0133  C  ...COMPUTE  E2  [ECCENTRICITY  SQUARED] 

0134  C  E2  s  [  1  -  [SEMI.MIN  DIVIDED  BY  SEMI.MAJ]  *  2J 

0135  C 

0136  E2  =  1.  -  CAXMIN/AXMAJ)**2 

0137  C 

013b  C  ...COMPUTE  MERIDIONAL  ARC  EXPANSION  COEFFICIENTS 

0139  C 

0140  C  A.  3  SEMI..M  AJ*KO*  (  1  -  E2  DIVIDED  BY  4  -3*E2*E2  DIVIDED  BY  64 

0141  C 

0142  A  s  AXMAJ*K0*(1.  -  E2/4.  -  3 . *E2*E2/64 . ) 

0143  C 

0144  C  B.  3  SSMI.MAJ*K0*E2*  [  1  ♦  E2  DIVIDED  BY  4  ]  DIVIDED  BY  0 

0145  C 

0146  B  s  AXMAJ*K0*£2*(1.  ♦  E2/4.)  /8. 

0147  C 

014b  C  C.  3  SEMI.MAJ*K0*E2*E2  DIVIDED  BY  256 

0149  C 

0150  C  3  AXMAJ *K0*£2*E2  /256. 

0151  C 

0152  C  ENDIF  WILL  GO  HERE 

0153  C 

0154  RETURN 

0155  END 
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0001 
ooo2 
oooj 
0o04 
000b 
000b 
000/ 
0000 
0009 
0010 
0011 
0012 
OOli 
0014 
001b 
OOlo  1 
001  /  1 
0010  1 
0019 
0020 
0021 
0022 
002  j 
0024 
002S 
002b 
002/ 
0020 
0029 
00  JO 
00J1 
OOJ2 
OOJJ 
00  34 
OOJb 
003b 

OOJ? 

00JO 

0039 

oo40 
0041 
0042 
004  J 
0044 
004b 
004b 
004/ 
0040 
0049 
OObO 
0051 
0052 
005  J 
0054 
0055 
005b 
005/ 


SUBROUTINE  UR*CJN(wiNXY,UBRES,CUNKES,EMlNf  ZMAX  ,  ZDEL  1'  ) 

********************************************** *******+*t***** ******* 

*  DRAMS  Eu£ V  A  TI JN  CONTOURS 

*******************************************************  ************* 

*  INPUTS:  N1NXY —  MlN,MAX  OF  EASTING  AnD  NOR  THING , KESPEC T I  V £b Y 

*  dopes--  database  resolution,  usually  ioom 

*  COMBES--  DISTANCE  BETWEEN  CONTOURS,  AT  LEAST  DOPES 

*  ZM  IN ,  ZMAX——  MINIMUM  AND  MAXIMUM  ELEVATION  IN  DATA 

*  ZDElT  —  CONTOUR  RESOLUTION,  USER-DEFIMEU 

*  OUTPUTS:  NONE 

*  N.B.  ALL  UNITS  ARE  IN  METERS. 

*  **♦  *H.  JONES  R.  LINOLEY  **+ 
******************************************************************** 

IMPLICIT  INTEGERS  U-N) 

INCLUDE  'MASK. DIM* 

********************************************************* 

BYTE  MASK(4o0,400,3) 

********************************************************* 

DIMENSION  MINX Y l 4) 

C 

C  SET  LONER  LEFT  AND  UPPER  RIGHT  INDICES. 

C 

ILLsI 

IUR=(»*INXYC2)-NINXY(  1  J  J/DBRES 
JLL-1 

JuR=(nInXY(4)-NINXY(3))/DBRES 

c 

C  SET  1,0  INCREMENT. 

C 

I JDELTA=MAX1 (COnRES/DBRES, 1 . ) 

C 

C  SET  X , Y  INCREMENT 

C 

X  Y  DEL  TA =D  BRES*FLO  AT  HJ  DELIA) 

C 

C  FORCE  MINIMUM  TO  BE  NON  INTEGER. 

C 

ZMlM3ANiNI(4MlN)40.b 

C 

C  FORCE  L  INCREMENT  TO  BE  INTEGER. 

C 

ZUELTsANlNTCZOELT) 

C 

C  *OkAn  COnTJUkS. 

DO  HEiGHT=ZMlN+ZO£Lr,ZMAX, ZDELT 

C  ‘  *  " 

C  *SEI  VALUE  OF  MASK  FOR  THE  THREE  SIDES  THUS: 

C  *  VALUE  OF  0  —  NUT  CHECKED 

C  ♦ V A L U E  OF  1  —  INTERCEPT 

C  *  V  A  L  U  E  JF  10  --  -  NO  INTERCEPT 

DO  K=1 , 3 

DO  JsjLL, JUR, IJUELTA 

00  IsILL,IUK, iuDELTA 
MASK(I,J,K)  s  0 
ENOOO 
ENDUO 
tNDDO 


00b8 

c 

* 

oob9 

c 

* 

1 1  +1 

OObO 

c 

* 

0061 

c 

* 

•  •  • 

0062 

c 

* 

•  •  • 

006  J 

c 

* 

•  •  • 

00b4 

c 

♦  2 

.  .4  .  IX  +  1 

006b 

c 

* 

•  •  • 

0066 

c 

* 

•  •  • 

0067 

c 

* 

•  •  • 

0060 

c 

* 

0069 

c 

* 

IX,  IT  1 

0070 

c 

* 

0071 

c 

0072 

c 

♦  SCAN  BOTTOM  EDGE  PJR  TRACE  STARTING  POINTS. 

00  7  J 

IT 

-  JLL 

0074 

YY  = 

FbOATdY/iJoELrA7*X  YUELTA 

0O7S 

00 

1 As ILL, lUK, IJoELTA 

00  7  b 

ICR OSS  =  0 

0077 

If (MASK(IX,IY, 17  .Ed.  0)  THEN 

oo  /  a 

CALL  iNTEKS(lA,iY,lXt' 

oo79 

♦ 

IJOELTA, I Y , HEIGHT, FK AC, ICK0SS7 

ooao 

EnOXF 

ooai 

IFdCROSS  .EU.  0)  THEN 

ouai 

MASK  X IX , XY,  1 7  a  10 

oo  a  j 

ELSE 

0084 

TESTER  a  1 

008b 

1TJP  s  0 

008b 

As pL J AT ( XX/ IJOELTA 7  *X YUELTA 

008  7 

XX  s  X  ♦  XYUELTA  *  FKAC 

0088 

CALL  MOVE  1  X X , Y  Y ) 

0089 

XXA=IX 

0090 

XY Y=1Y 

0091 

CALL  TKACE  (XXX, IYY ,XEnTeR, HOP, HEIGHT, MASK, 

0092 

$ 

A YUELTA, ILL, lUK, JLL, JUR, IJOELTA 7 

0094 

EnOXF 

0094 

ENO0J 

009b 

c 

009b 

c 

*  SCAN  SIDE  2  OF  KESdLUTXUN  ELEMENTS  FUR  TRACE  STAKTiN 

009  7 

00 

IY  s  JLL, JUR, IJOELTA 

0098 

Y=FLOA Tl I Y/XJOEbTA) *X YUELTA 

0099 

00  XX  s  'ILL, IOR, IJOELTA 

0100 

c 

oioi 

XCHJSS  s  0 

0102 

IF(MASK(XX, I Y,2)  .EO.  0)  THEN 

oioj 

CALL  XNTEKSX IX, X Y , IX, 

0i04 

f 

IY+IJOELTA, HEIGHT, FKAC, X CROSS 7 

0105 

ENOIP 

OiOb 

c 

0107 

IFXICRUSS  .Ed.  07  THEN 

0108 

MASK (XX, XY, 27  =  10 

0109 

ELSE 

olio 

ITOP  =  0 

0111 

TENTER  s  2 

0112 

XXspLOATdX/ IJOELTA  7  * A YUELTA 

0114 

YY  s  Y  *  XYOELTA  *  fRAC 

0114 

CALL  MOVE  UX,YY) 

POINTS. 
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11 


IXX=IX 

£**=!* 

CALL  I'HACE  ClXX,I)fX,IENfEK,iTUP,  HEIGHT,  MASK, 
'XXDt;Ll'A,lLL,IUR,JLL,JJR,  I  J  DELI  A) 

HOP  =  1 

lENi'EH  =  2 

CALL  MOVE  (XX, XI) 

IXXsIX-iJoELTA 

IXX=IX 

CALL  i'KACE  (1XX,  I  X  X  ,  IfcMfEK,  lXUP  , HEIGHT,  MASK, 
XXi)ELiA,ILL,IUR,JLL,JUR,lJDELiA) 

tMUlr 

ENOU'J 

C.MUOJ 

ENDtfU 

Rtf  URN 


0001 

ouo2 

0003 

ooo4 

000b 

000b 
000/ 
0000 
ooo9 
0010 
0011 
0012 
001 J  1 
0014  1 

00lt>  1 

001b  1 

001  /  1 
oulu  l 
ooi9  l 
0020  1 
0021  1 
0022 
002  J  1 
0024  1 

002b  1 

0U2b  1 
002  /  1 
0U2U  1 
Ou29 
OUJO 
ou3i 
0032 
0033 
00i4 
0035 
003b 
003/ 
003U 
0039  C 
0040  C 
0041  C 
0042  C 
0043 
0044 
004$ 
004b 
0047 
004U 
0049 
0050 
OOS1 
0052 
0053 
0054 
0055 
005b 
005/ 


SUBROUTINE  p  tATUKt.SC  InCK ) 

************************************************************** 


*'  THE  FEATUkE  C JOtS  AKt  DISPLAYED  On  A  1'EK  4027  Bl  * 

*  okAmIihU  r  n  £  CJLUMNS  IN  APPROPRIATE  COLORS  * 


*  INPUTS:  INCR,  THE  INCREMENT  FOR  MOVES  AND  DRAWS  ♦ 

*  IT  IS  USUALLY  SET  T01  OR  2.  * 

*  OUTPUTS:  NOnE  * 

************************************************************** 


INTEGER*2  1 C  K 
DIMENSION  I  w  I  N  (  4  ) 

INCLUDE  'wlNOJ.CMN' 

*******  ******  *********  **************************************** 


*  FwInXY  CONTAINS  THE  X  MIN  AnD  MAX  AnD  THE  Y  M £ N  AND  * 

*  MAX  RESPECTIVELY  FOR  THE  WINDOW.  MIN  AND  MAX  REFER  * 

*  TO  f HE  AIN  AND  MAX  JF  ELEVATION  VALUES,  AND  ZuELT  IS  * 

*  THE  CONTOUR  INTERVAL.  * 

************************************************************** 


DIMENSION  FmINXY(4) 

CJMMON/wINDU/FWINXY,MIN,MAX,ZDELr 

************************************************************** 


INCLUDE  'CORNER. CMN' 

***** ********************************************  ********** 

*  SwX ,  5w  Y  are  THE  SOUTHWEST  UTM  COORDINATES  OF  THE  * 

*  AREA  IN  THE  ARRAY  IBUF.  * 

IN  TEGtKM  SwX , S* Y 

COMMON/COKNtR/SWX,SWY 

ft**************************************************** 


INTEGERS  ix, iy,indx,indy,icoue 

c 

C .  IwIn  INDEXES  IBUF, WHILE  FwInXY  SETS  THE  WINDOW 

C .  F JR  MOVES  AND  DRAWS 

C...  Trie  FOLLOWING  IS  A  rvLUDGE  ON  A  MOKE  FLEXIBLE  VERSION 

C...  OF  THIS  ROUTINE 

IwlNC  UsIFWINaYU  J-SWX)/lUOtl 
IwlN(2)s(FWiNXYC2 j-SWX)/100 
IwlNC 3) s( FWINXY ( 3 ) -SW Y ) / IUO+ 1 
IwInC 4)s( FWINXY (4) -SWYJ/100 
0  CALL  CM CL OS 

D  PRINT*, INCR, IwIN 

D  KEAD*,JUNX 

□  call  cm jpen 

C  F JR  EACH  X 

CALL  CM OPEN 

OJ  IXsIwINI 1 ) , IwlNl 2) , INCR 
XI=(IX-1 j*ioo.*swx 

C  SET  FEATURE  CODE  VALUE  FUR  SCAN 

IC=IC0DE(IWIN(3) ,IX/ 

YlsFWINXY C  3/ 

C  MJVE  10  BOTTOM  OF  WINDOW  FOR  THIS  SCAN 

*  CALL  AOVeiXI.YI) 

C  FOR  EACH  i 

OJ  iYsIwlNl 3) , Iw!N(4) , INCH 

C  THE  POINTS  IN  THE  DATA  BASE  ARE  100M  APART 

YI*(lY-l)*100.*SwY' 

C  IF  NO  CHANGE, CONTINUE  READING 

IF  1 1 CODE (IY,IX}.EU.IC)GOI010 


B-145 


FEAIUkES 


0U5U 

C  •  •  •  • 

• 

ELoE 

0059 

c 

DRArf  A  blNE  I«  1'HE  APPROPRIATE 

COLOR 

0060 

c 

RED  FJR  ' URdAw '  AmD  GhEEN  FOR 

'FOREST 

0061 

CALL  UnCLKUC) 

0062 

CALL  OKA*(Xl, HI/ 

006  j 

C 

SET  THE  NE*  FEATURE  CODE 

0064 

IC=ICOUEtIT ,1XJ 

0065 

10 

CONTINUE 

0066 

ENDOO 

006  / 

C  •  •  •  • 

• 

OKA*  TO  THE  TUP  IF  nECESSARI 

0066 

call  linclrc icuoecii-Incr,  ia) j 

0069 

CALL  L>RA*(X£,XlJ 

00/0 

ErtDUU 

00/1 

CALL  CMCLJS 

0072 

RETURN 

0o72 

END 

OOOl  SUBROUTINE  Fl  bLoP  (  N  ,  VV  ER  TS  ,  1  CUD  ) 

000  2  **tnn*f*i***$*****4*i*  ******  **************  **************************  ****4, 

OOO j  ♦  N  1b  1‘He.  INPUT  NUMBER  Ur'  ORDERED  V ERTICtS  4H1CH  SPECIFY  THE  1 

0004  *  BJU.»UARY  JK  r cl E  SIMPLE  CLOSED  POLYGON.  BiNCE  i'HE  FIRS!  AND  bABT 

OUOb  *  VERTEX  ARE  UNDERSTOOD  TO  BE  IDENTICAL,  THE  NUMBER  OF  PHYSICAL  ! 

0006  *  VERTICES  IS"N-1.  ' 

000/  *  VVErtTS  IS  THE  ARRAY  C JN  TA 1 N 1 NG  THE  POLYGON  VERTICES. 

OOOB  *  A-CauRDl'.ATE  OF  THE  K-i'M  VtRTEA  s  WtRiS(K,l) 

0009  *  Y -COORDINATE  OF  THE  K.-TH  VERTEX  s V V EH TS ( K , 2 ) 

0010  ♦  IVEKTil,*J=lVERT(Nf *)  IS  ASSUMED.' 

0011  * 

0012  *  THE  4 JKLD  GRID  POINTS  LYING  HITHIn  THE  POLYGON  ARE  FILLED  BY  THIS 

001 i  *  SUBROUTINE.  THE  NETHJO  OF  OPERATION  IS  AS  FOLLOWS. 'EACH  VERTICAL 

0014  *  LINE  THROUGH  the  PQlYGUN  IS  EXAMINED.  IN  PRACTICE,  THE  LINE* 

OolS  *  INTERSECTS  THE  POLYGON  BOUNDARY  AT  AN  EVEN  NUMBER  OP  POINTS 

0016  *  (IF'NJT,  THE  LINE  IS  SHIFTED  SLIGHTLY).  THEN,  FROM  BOTTJM  TO  iOF, 

0017  *  RE  "PAInT"  THE  UnE  SEGMENTS  BOUNDED  BY  THE  FIRST  AND  SECJNu 

ooio  *  intersections,  by  the  third  and  fourth  intersections,  etc. 

0019  * 

0020  *  THE  LINE  SEGMENTS  WHICH  FORM  THE  FOLYGON  BOUNDARY  ARE  ORDERED  BY 

0021  *  INCREASING  VAuUES  OF  X.  THIS  HELPS  TO  SFEED  UF  THE  ADEN fl FI CA TIUN 

0022  *  of  Intersections  between  the  boundary  segments  and  the  vertical 

0029  *  "PAINT  LINES". 

0024  ************************************************************************* 

002b  DIMENSION  V  VERTS ( bOO , 2 ) , VERTS ( 500 , 2 ) , LO*Li ( SOO ) , I CR JSS ( SO 0 ) 

002b  DlMENSUN  YHOLD  (  20  )  ,  I  LIST  (  20  )  ' 

002/  INTEGERS  IEL  V  ,  ICJD 

0026  INCLUDE  'MAP.CMN' 

0029  l  *********************************************************** 

OOJO  1  *  IbUF  HOLDS  A  40*4oKM  ARRAY  JF  DISPLAY  DATA , 4l  TH  * 

OOJ1  1  *  THE  FIRST  INDEX  CORRESPONDS  TU  WORTHING,  AND  * 

0 ui2  l  *  THE  SECOND  TO  EASTING.  -  -  * 

OOJO  1  *********************************************************** 

00 J4  I  InTeGER*2  IbUF(400, 400) 

00 Jb  l  CJMMOn  /MAP/IBUF 

00 36  1  *********************************************************** 

OOJ/  INCLUDE  'windu.cmn' 

OOJO  1  ************************************************************** 

0039  1  *  F  4 1 N  X  Y  CONTAINS  THE  X  MIN' AND  MAX  AND  THE  Y  MIN  And  * 

OU40  1  *  MAX  RESPECTIVELY  FUR  THE  MlnUUW.  MIN  AND  MAX  REFER  * 

0041  1  *  TJ  THE  MIN  AND  MAX  OF  ELEVATION  VALUES,  'AND  ZDELTIb  * 

0042  1  *  TriE  *CUN  TOUR  INTERVAL.  .  '  * 

0043  1  *************************************************************4 

0044  1  DIMENSION  F4lNXY(4) 

004$  1  C0MM0N/4IND0/FW1NXY , MIN , MAX , ZDEb T 

0046  1  **4*4***4**********44*444**444*4*4****444*4*4*4****4*4******** 

0047*  ' INCLUDE  'COHNER.CMN' 

0046  l*********4*44*******4*4*4**4*******4**4*4*4*4*4*********4** 

0049  1  *'  S4X,S4Y  ARE  THE  SUUI’HnEST'  Ul'M'  COORDINATES  UF  THt  ♦ 

OObO  I  *  AREA  IN  THE  ARRAY  IBUF.  * 

OObl  1  I N  TEGtH  *4  S4X,S4Y 

0Ub2  1  CJMM0N/C0RNER/S4X,S4Y 

0053  1  *4444 4** 4444*4*4*4***4*4*444**4*** 4* *****44*4*4*4 *44*4* *44* 

0054  NSSN-1 

OUbb  C 

0056  C  FIND  THE  Ml  V I  MUM  «,  MAXIMUM  VALUE.  Ur  X  «HH1N  THE  POLYGON, 

005/  C  XXMlN  AND  XXMAX.  ALSO  KING  THE  CtN T EK-OF-MASS-  OF  THE  POLYGON  VEkTICi 


F  TLlUP 


OOSd 

0058 

oobo 

OObl 

00b2 

OUbJ 

OOb4 

aobs 

OObb 

aub/ 
aobs 
oob9 
au/0 
ao/i 
ao/2 
au/ j 
uo  /4 
uo7S 
00  7  b 
oo?7 
oo?8 
oo/9 
0080 
0081 
0082 
008  j 
0084 
0085 
008b 
0087 
0088 
0089 
0080 
0081 
0082 
008  j 
0084 
0095 

008b 
0087 
0088 
0089 
0100 
OlOl 
0l02 
oio  j 
0104 
0105 
OiOb 

oio/ 
0108 
oio9 
oiiO 
oili 
oi  12 
oili 
o  i  i  % 


UCm,YCm). 

XAMlNsl.Oe.lO 

XaMAX=-1.UE10 

7 1 M INs 1 . Obi  0 

YYMAX=-l.uE10 

XCM  =  0  .  0 

7CM=0.0 

OJ  10  1=1, NS 

XCM=XCMfVV£RTS(I,1) 

Y CM® YCMFV VERTS (1,2) 

if C vvertsu, i j .lt.xxmin)  xxmin=vvertsii,u 

If  (  VVERTSil,  1  j  .oT.XXMAXJ  XXNAA=vVeRTS(I,  1  j 
If  (VVERTSCl,2j.Lr.YYMlN)  XXhIn=VVeRTS( I, 2) 

If(VVEHTS(l,2j.GT.YkHAXj  i  I M AA= VVER  TS( 1 , 2  j 
10  CJN  1'lNUE 
XCM=XCM/NS 
YCM=YCM/NS 

Siller  EACH  VErTeX  SLIGHTLY  l APPROXIMATELY  AmAY  FROM  Irik  CM). 

THIS  SHIFT  AVOIDS  HAVING  *WUHi<INGw  vErTICIES  WHICH  LIE  DIRECTLY  A  TUP 
NJKLO'GHID  POINTS.  *  .... 

DO  20  1=1, N 

VtRiSH,!  )=VVeRTS(I,1)  ♦  .0001*lVVERTS(i,l)-XCM) 

Ve.«fS(l,2 j=VVERiS(l, 2)  ♦  .000i*(VVEKrs(i,2)-XCM) 

INITIALIZE  AN  ARRAY  TO  All)  IN  SORTING  VECTORS. 

ICR OSS ( 1 ) =0 
20  CONTINUE 

THE  PJLYGON  SIDE  VECTOR  NUMBEHED  1  IS  UNDERSTOOD  TU  HAVE  ENOPoINIS 
VERTSlI,*)  AND  VERTS!!*!,*) •  *  THeRE  ARE  N-l  SUCH  VECTURS,  AND  wE  NOW 
S JR T  THEM 'ACCORDING  ro  INCREASING* VALUES  OF  "MINIMUM  A"i 
THE  ARRAY  LJWLlC*)  CONTAINS  THE  RESULTS  OF  THE  SORTING* 

E. G.  ,  LOWLl (*)s*l,50,2,J,48,...  WOULD  MEAN  THAT  VECTOR  NUMBER  I 
HAS  THE  SMALLEST  LEFTMOST  X-COQhDINATE, ’ VECTOR  NUMBeRSO  iSSECONO 
SMALLEST  IN  X,  ETC. 


TLY  ATOP 


00  100  K=1,NS 

FIND  THE  K-TH  SMALLEST  (IN  X) 

XMlNsl.oElO 
do  soi=i;ns 

If  (I  CROSS!  IJ.EO.l)  GO  TO  SO 
X  =  AM I N 1 (VERTS! £ , 1 j , 7  E  R  T  S  C 1  +  1 , 1 ) ) 

IF ( A.GT.XMIN) *GJ  TO  SO 
K£Y=I 
XmIN=X 
SO  CONTINUE 

LOWLl IK)=AEY 


VECTOR. 


CROSS  OFF  THE  K-TH  SMALLEST  VECTOR 
From  further  consideration. 


ICKJSSUEY  )=1 

loo  continue 


Find  x-cooroinates  which  bracket  the  world  region  tj  be  filled. 


FILLUP 


<n  is 
oiio 
oil/ 
oiia 
oii9 
oi20 
ui2i 
0122 
oi23 

0  i  24 
0125 
0i2b 
0i27 
Ui26 
0129 
uiiO 
uiii 
oi32 
ul  33 
0134 
oiiS 
0136 
0137 
oiiu 
oi  3-9 
o  1 40 
0141 
0142 
0I4J 
0 1 44 
0145 

oi  46 
0147 
0146 
0149 
oib  0 
0161 
oi  52 
0153 

0  i  5  4 
0155 
0156 
oi57 

0150 
0159 
0 160 
Oibl 
oib2 
oibi 

Olb4 

OlbS 

Oibb 

o!67 

Oibb 

oib9 
oi  70 
oi  7i 


c 

1xX41n=1K TX(.XaM1N/1007*10U  -  100 
i*x  iaa=i>  ixixx'MAX/ioo 7  *ioo  4  ioo 
c 

C  LJUP  JVeR  V EN  TlCAL  CULU.1NS  Of  GRlu  POINTS  rfll'nlN  THE  PUlYGUN. 

C  .  ....  .  - 

KSTAKlsl 

Oj  300  iC  =  lXXrtI.4,lXAMAX,  100 

x=iC 

C  F1MU  NUMBER  Of  i N  TER SEC  T  TUNS  l  M 1 N  TER  )  UK  THE  VERTICAL  CJLJMN 
C  NIT  h  1  He.  POLYGON  SlUE* VECTORS; 

150  NINTERSO 

Oj  200  K=nSTAKT,NS 
Kb0=l  '  * 

l  =  LJ*bUKJ 
C  . 

C  SEE  If  VECTOR  1  INTERSECTS  THE  COLUMN  LINE  X  =  iC. 

C  ‘  ‘ 

IK(X.LT.AMINHVERTSU,1),  VEKTSti4l,l)7  )  GU  !U  210 
lF(X.Gr.AAAAl(VERTSU,l),VERTS('i4i,l)7)  GU  ID  200 

C  -  -  -  * . . . 

C  AN  INTERSECT! JN  HAS  BEEN  KOONU.  CALCULATE  THE  Y-COURDINATE  C  V  J 

c  ok  ini  Intersection  point.  '  ~  . 

c  .... 

XlsVEHTSU,  1) 

X2=V£HTS(i4i,l) 

Yi=VEKrs(i,2) 

Y  2  s  V  E  K  T  S ( 141,2) 

.  SbOPE=CY2-Yl)/(x2-Xl) 

Y=SbOPE*(X-X174Yl 
N IN  TEKSNlN TEH+1 
YriOLOiNlNTEH)sY 

c  kjh  rHE'KirtSr  intersection,  keoefine  isiart  fur  the  next  column. 

if  c  nInTeK. EJ. 1 )  KSO=K 

200  Continue 
210  AsTAHisKSO 

C  NAKe  SURE 'THAT  THERE  are  an  even  number  ok  INTERSECTIONS. 

If  (  MUlKnInTER,  27  .EU.07  GO  TU  220  ' 

XiXKl.-O 
GJ  i'O  150 

220  Ir (nInTER.EO.O)  Gu  TU  300 
C  ■ 

C  SORT  THE  Y-CUURUInATES  JK  THE  INTERSECTION  POINTS  BY  INCREASING 

C  VALUE.  TLlSl’T  K  7=3, 7,2;  ...  MeANS  THAT  THE  TH1R0  I N  TER5EC  T 1  JN  '  K  JUNO  HAS 

c  the'smallest  y-couruinate,  the  /-th ' intersection  has  the  next . 

c  smallest  y,  'etc;  -  ....  -  ..... 

C  NOTE  THAT  NUN  ~ICRJSS(*7=1 
OJ  225  Asi , NlNTER 
225  I  Cross C  K  7  =  1 
C  -  -  -  - 

OJ  250  A=1  , NInTER 

YMlNsi.OEiO 

OU  230  L^l , NlN TER 

IK( ICrUsST L7 .EQ.07  GU  TU  230 

Y  =  Y  riULOlL  7 

IK C  f . GT J Y MIN )  GJ  TO  230 
AeY»L* 
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•«.  ^ 


fillup 


0172  *NlN=X 

oils  2 so  cjniinuc 

oi/4  iliutikisaei 

Oi  7b  ICRJSSIkeX  7=0 

01 76  230  Continue 

017/  C 

Oi?a  C  FOR  TESTING,  UK  AM  THE  COLUMN  UN  THE  TERMINAL  SCREEN. 

oi/9  c 

Oiau  00  200  K=2,NlNTER,2 

oiai  YisiHULo(iLiSi(N-i) j 

0182  Y  2*IHljL0C  ILISTC  A  J  ) 

oioi 

0184  IAsiC/100 

0185  I^l=T(lUL0(.lLloTiK-ni/10U 

0186  li2=XHUL0(lblST(K  )  )/100 

018/  00  lTsiii;i!t2  *  ‘ 

0188  "  iBUECiX,lXjslEbVlXltiAJ*8+iCuD 

oiOy  enouo . 

oi90  x=iC 

Ol9l  280  CONTINUE 

0192  C  ' 

oiyj  3oo  continue 

0194  FilNXill  )=SNX*XXMlN 

Oiyb  F«lNXX(2)sS«XtXXMAX 

0196  FMlNXX(i)sS*Y+YXMlN 

019/  FmInXX (4)=S«X*YXMAX 

0198  C  O  CALL  CMCLOS 

0199  C  0  PRINT*, t MINAY 

O2o0  C  o  call  cm Open 

0201  '  RETJRN 

0202  EnO  * 
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0001 
ooo2 
ooo  j 

0004 

oooS 

OOOo 

ooo7 
*  oooS 
ooo9 
.  uoiG 
0011 
ooi2 
ooii 

0014 
00  i  3 

ooib 
ooi/ 
ooid 
ooi9 
oo2o 
ooii 
eo22 
002  j 
oo24 

0023 


1 

i 

i 

l 

1 

i 


SOdrtUOi'lNt.  oE<< 

it*  mm*******  4  ***  ******  ****************  t********** 


*'  r  Hlj  K  U  o  r  1  M  c.  oErttKAltb  £Ht  t  ICE  NAMES'  AN  O'  * 

*  R&LAlivE  INOlCtd  rUK  HE2KirI.No  iHE  OAiA  * 

*  i.VfU  frit  lOiVN'f  iLfcS;  ANO  KEwKliES  TriE'OAfA  * 


INCLUDE'  'COkNER.CmN' 


*  S*K,S*l  '  AhE"  TnE'  SJUrHaEdl'  OiM'  COORDINATES'  Uf  THE 
*  AKErt  IN  frt£  AkRA  1  i  dlif. 

l.*lt(itK*4  S*X,S*t 
CJMrtUN/CUKNEK/S«X,S«Y 


CrtAkACTtR#/  Mv>R . 

LdLiCALM  ' ERR  ~ 

OJ  jso#i 

lEASi=ddX4J*10000 

uu'lio; J" 

'  N JH1H=S- Y+l*10000 

CALC  JTi<42M(*RCiEAS£ »tNJKTn»MGKrc.RK) 
CALC  MAHJUTii, J,MOK,ENRi 
tNUOd 
E.nOUU"  ’ 

RtTOHN 

EnO~ 
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c 

c 


0001 

0002 

0003 

0004 

0005 

0006 

0007 

0008 

0009 

0010 

0011 

0012 

0013 

0014 


c 

c 


c 

c 

c 


SUBROUTINE  GETN0X(R EC. MUm, INDEX# PQS) 

IMPLICIT  IMTEGER*4( A-Z) 

A  ROUTINE  fO  DETERMINE  ON  RHICH  500  wORD  PHYSICAL  RECORD 

JF  UNIT  #LU#  THE  5  WORO  LOGICAL  RECORD  'KECNUM'  RESIDES. 

SUBTRACT  1  TO  TAKE  CARE  OF  MULTIPLES  OF  100 
NsRECNUM-1 
iNDEXsN/lOOtl 

INDEX  IS  THE  PHYSICAL  RECORD  INDEX 

POS  IS  THE  POSITION  OF  THE  LOGICAL  RECORD  MITHI.N  THE 

PHYSICAL  RECORD 
POS=RECNUM-( INDEX-1) *100 
RETURN 
END 


0001 

0002 

0003 

0004 

0005  C 

0006  C 

0007  C 

oooa  c 

0009  C 

0010  C 

0011  c  o 

0012 

0013 

0014 

0015 

0016 


SUBROUTINE  3£TREC(LU,NUM,PREC) 

IMPLICIT  IMrEGER*4(A-Z) 

01 MENSION  PRECNUM(3) ,PKEC(500) 

DATA  PRECNUM/3*0/ 

A  ROUTINE  TO  RETRIEVE  PHYSICAL  RECORD  NUMBER  'NUM' 
FROM  UNIT  'LU' 

FIRST  CHECK  TO  SEE  IF  THE  PHYSICAL  RECORD  IS 
ALREADY  IN  CURE. 

PRINT*, MUM, LU 

IF( MUM.EQ.PRECNUMCLU-l ) )  RETURN 

REAO(LU'NUM)  PREC 

PKECNUM(LU-l)sNUM 

RETURN 

END 
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oooi 
02 

0003 

0004 

OOOb 

000b 

0007 

0008 

oooy 

0010 

0011 

0012 

Ouli 

0014 

0015 

001b 

0017 

0018 

0019 

0020 

0021 

0022 

0023 

0024 

0025- 

002b 

0027 

0028 

0029 

0030 

0031 

0032 

0033 

0034 

0035 

003b 

003/ 

0038 

0039 

0040 

0041 

0042 

0043 

0044 

0045 

004b 

0(74/ 

0048 

0049 

0050 

0051 

0052 

0053 

0054 

0055 

005b 

0057 


SUBKOU  TINE  GETSUB(SRECNUM,  *RDPOS,N) 

*************** 

C*****  REVISED:  6/11/82 

F 38  USE  WITH  ROADHEXER 

C* **********************************  *******  ********* 

c 

C  THIS  ROUTINE  TAKES  THE  SUBNODE  COORDINATES  FOR 

C  OmE  LINK  AND  PUTS  THEN  INTO  THE  ARRAY  SUBXY 

C 

IMPLICIT  1NTEGER*4  (A-Z) 

REAL  Y 

INTEGER *2  N 

INCLUDE  'LNKNOD.CMN' 

**************************************************************** 

*  ARRAYS  FOR  THE  GRID, NODE, LI nK, AND  SUBNODE  FILES  * 

**************************************************************** 

I «TEGER*4  GRID,NODREC,LNKREC,SUBREC 

COMMON  /LNKNOO/GR ID{128, 128), NODRECt 5 ,100),LNKREC(5,100) 

*  , SUBREC ( 500 ) 

***************************************************************** 
INCLUDE  'SUB.CMN' 

*********************************************************** 

*  SUBX , SUSY  THE  X  AND  Y  COORDINATES  OF  THE  SU8N00ES  * 

*  IN  ONE  LINK  (SEE  BOX  DOCUMENTATION)  * 

*********************************************************** 

INTEGERS  SUBX(100),SU6Y(100) 

CJMMON/SUd/  SUBX , SUB Y 

********************************************************** 

D  PRINT*, 'INPUTS: ' , SRECNUM , WRDPOS 

Lus  1 

CALL  GETR£C(LU,SRECNUM,SUBREC) 

C  1HE  FIRS!  ENTRY  IN  THE  SUBNODE  LOGICAL  RECORD  IS  TWICE 

C  THE  NUMBER  OF  POINTS  IN  THE  SUBNODE  LIST 

C 

NsSUBR£C( nRDPOS) /2 
D  PRINT*, 'N',N 

C  CHECK  TO  SEE  IF  ALL  OF  THE  LOGICAL  RECORD  IS  WITHIN  THE 

C  PRESENT  PHYSICAL  RECORD, 

C 

IF ( N+WRDPOS.LE . 500 )  THEN 
DO  K= 1 , N 

LsWRDPOS+K 


********************* 
*****  UNPACKING  THE 
********************* 

*  SETTING  THE  X 
TMpsLIB$CX  TZV 
CALL  LIBSINSV 

*  setting  the  y 

TMPsUBSEXTZV 
CALL  LlBSlNSV 

********************* 

ENDOO 

ELSE 


NCLUDC  'SUBNODE. SET' 

************************** 
SUBNODE  COORDINATES 
************************** 
COORDINATE 
(0, 16,SUBR£C(L) ) 
(TMP,0,lb,5UBX(K) ) 
COORDINATE 
(  16, 16,SUBREC(L)) 
(TMP,0,lb,SUBY(K)) 
************************** 


GETsUb 


0058 
0059 
O060 
0061 
0062 
0063 
0064 
0065 
0066 
0067 
0060 
0069 
0070 
0071 
0072 
0073 
0074 
0075 
0076 
0077 
0078 
0079 
0080  C 
0081 
0082. 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 
0092 
0093 
0094 
0095 
0096 
0097 


C  GET  THE  BEGINNING  Of  THE  LOGICAL  RECORD 

NdEG=500-rtRDP0S 
DJ  K=1,NBEG 
L=NRDPOS+K 

INCLUDE  'SUdNQDE.SET' 

1  *********************************************** 

1  *****  UNPACKING  THE  SUBNOOE  COORDINATES 
1  *********************************************** 

1  *  SETTING  THE  X  COORDINATE 

1  TNP=LlB$EXrZV(0,16,SUaREC(L)) 

1  CALL  LIB$INSV(TMP,0,la,SUBX(K) ) 

1  *  SETTING  THE  Y  COORDINATE 

1  riP  =  HB$EXrZV(16»l6,SUBREC(L)J 

1  CALL  LIB$INSVlTMP,0,la,SUBY(K)) 

1  *********************************************** 

ENDDO 

C 

C  GET  NEXT  PHYSICAL  SUBNODE  RECORD 

SRECNdH=SRECNUM>l 
CALL  G£TR£C(LU,SRECNUM,SUbR£C) 

C  GET  THE  REMAINDER  OF  THE.  LOGICAL  SUBNODE  RECORD 

NR£M=N-NB£G 

D  PRINT*, 'NREN',NREM, 'K',K, 'L',L 

DO  L=l , NKEM 
K=NBEG+L 

INCLUDE  'SUBNOOE. SET' 

1  *********************************************** 

1  *****  UNPACKING  THE  SUBNOOE  COORDINATES 
1  *********************************************** 

1  *  SETTING  THE  X  COORDINATE 

1  TMP=LIBSEXTZV(0,16,SUBRECCL)) 

1  CALL  LIBS1NSV(TMP,0, 16,SUBX(K) ) 

1  ♦  SETTING  THE  Y  COORDINATE 

1  TMPsLIB$EXTZV(lb,l6,SLBKECCL) ) 

1  CALL  LIBSINSV(TMP,0, 16,SUBY(K) ) 

1  *********************************************** 

ENDDO 

ENDIF 
C 

RETURN 


0001 

0002  C 

0003  C 

0004  C 

0005  C 

0006  C 

0007  C 

0008  C 

0009  C 

0010  C 

0011  C 

0012  C 

0013  C 

0014  C 

0015  C 

0016  C 

001/  C 

0018  C 

0019  C 

0020  C 

0021  C 

0022  C 

0023  C 

0024.  C 

0025  C 

0026  C 

0027  C 

0028  C 

0029  C 

0030  C 

0031  C 

0032  C 

0033  C 

0034  C 

0035  C 

0036  C 

0037  C 

0038  C 

0039  C 

0040  C 

0041  C 

0042  C 

0043  C 

0044  C 

0045  C 

0046  C 

0047  C 

0048  C 

0049  C 

0050  C 

0051 
0052 
0053 
0054 
0055 
0056 
0057 


SUBROUTINE  HA2IJM(HADR,I,J,LEV) 

*  R  JUTI.N£(CONVE«r  HEX  ADDRESS  TO  MIN  LEVEL  I,  J  COORDI NA  TES- H  A2 1 JM  ) 
****************************************************************** 

*  OESIGNER/PKOGRAMmER: 

*  DJN  KRECKER  19  SEPTEMBER  1980 

*  purpose: 

*  H  A  2  I J  M  CONVERTS  A  HEX  ADDRESS  IN  OCTAL  REPRESEN T A TI ON  TO 

*  ITS  EQUIVALENT  I,J  OBLIQUE  COORDINATES  AT  THE  MINIMUM  LEVEL 

*  OF  HEX  AGGREGATION.  THESE  I,J  COORDINATES  ARE  EXPRESSED  IN 

*  UNITS  OF  HEX  DIAMETERS  OF  THE  SMALLEST  SIZE  HEX  IN  THE 

*  CURRENT  CONFIGURATION  AND  CORRESPOND  TO  THE  CENTER  OF  THE 

*  GIVEN  HEX.  THE  LEVEL  OF  AGGREGATION  OF  THE  HEX  IS  ALSO 

*  RETURNED.  HA2IJM  IS  THE  INVERSE  OF  THE  FUNCTION  IJM2HA. 

*  THE  ALGORITHM  PULLS  DIGITS  OFF  THE  HEX  ADDRESS  ONE  BY  ONE 

*  FROM  RIGHT  TO  LEFT.  AS  EACH  DIGIT  IS  PULLED  OFF,  IT  IS 

*  CONSIDERED  TO  BE  THE  LEFTMOST  DIGIT  AND  THEREFORE  REPKE- 

*  SENT  THE  HEX  AT  THE  HIGHEST  LEVEL  OF  AGGREGATION  CONTAINING 

*  THE  GIVEN  HEX.  ACCORDINGLY ,  THE  I,J  COORDINATES  (AT  THE 

*  MINIMUM  LEVEL)  CORRESPONDING  TO  THIS  LARGEST  SIZE  HEX  ARE 

*  ADDED  TO  RUNNING  I  AND  J  TOTALS.  IF  ANOTHER  HEX  DIGIT  IS 

*  FOUND,  THEN  THE  PREVIOUS  DIGIT(S)  ACTUALLY  REPRESENT  HEXES 

*  OF  LOmER  LEVEL.  A  TRANSFORMATION  IS  APPLIED  TO  SHRINK  THE 

*  CURRENT  I,J  VECTOR  TO  THE  NEXT  LONER  LEVEL,  AND  THE  ALGO- 

*  RITH.4  CONTINUES  WITH  THE  NEw  DIGIT.  THE  ALGORITHM  TER- 

*  MINA  TES  WHEN  NO  MORE  NONZERO  HEX  DIGITS  ARE  FOUND.  THE 

*  LEVEL  OF  THE  HEX  IS  DETERMINED  AS  THE  MAXIMUM  NUMBER  OF 

*  LEVELS  OF  HEX  AGGREGATION  MINUS  THE  NUMBER  OF  DIGITS  IN 

*  THE  HEX  ADDRESS.  HA2IJM  CHECKS  TO  ENSURE  THAT  THE  INPUT 

*  HEX  ADDRESS  Is  POSITIVE  AND  HAS  A  VALID  NUMdER  OF  DIGITS. 

*  CALLING  SEQUENCE: 

*  CALL  HA2IJM(HADR,I,J,LEV) 

*  input: 

*  HADR  -  HEX  ADDRESS  FOR  WHICH  EQUIVALENT  I,J  COORDINATES 

4  AT  THE  MINIMUM  HEX  LEVEL  ARE  TO  BE  COMPUTED 

*  NHLEV  -  MAXIMUM  NUMBER  OF  LEVELS  OF  HEX  AGGREGATION. 

*  (IN  COMMON/HEX/.) 

*  MINLEV  -  MINIMUM  HEX  LEVEL.  (IN  COMMUN/HEX/) 

*  IMAX(HDIG) 

*  JMAX(HOIG) 

*  -  ARRAYS  CONTAINING  THE  I,J  COORDINATES  (AT  THE 

*  MINIMUM  HEX  LEVEL)  OF  THE  CENTERS  OF  EACH  OF  THE 

*  /  HEXES  OF  MAXIMUM  LEVEL.  ( TH£  MAXIMUM  HEX  LEVEL 

*  IS  NHLEV  -  1.) 

*  OUTPUT: 

«  I,J  -  JBLIQUE  COORDINATES  (AT  THE  MINIMUM  HEX  LEVEL)  OF 

*  THE  GIVEN  HEX  ADDRESS 

*  LEV  -  LEVEL  OF  AGGREGATION  OF  THE  GIVEN  HEX  ADDRESS 

****************************************************************** 

IMPLICIT  I N  TEGEK ( H , P ) 

CJMMON/HEX/IHXOUT, NHLEV, MINLEV, SLT0,CLTU,DLN0,DiA4(lU),0IAMf 
$  R , 

*  XJFI,YOFI,XOFJ,YOFJ,RIJFX,RJJFX,  >1 JFY . <JDFY, 

*  ICON (70), JCON(70)  ,IMAX(7) , UMAX (7 ) 

DIMENSION  IVALC7) , JVALC7) 

EQUIVALENCE! I VALC 1 ) , ICON( 1 ) ) , ( JVAL( I ) , JCON( 1 ) ) 
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0001 

0002 

0003 

0004 

0005 

0006 

0007 

0008 

0009 

0010 

0011 

0012 

0013 

0014 

0015* 

0016 

0017 

0018 

0019 

0020 

0021 

0022 

0023 

0024 

0025 

0026 

0027 

0028 

0029 

0030 

0031 

0032 

0033 

0034 

0035 

0036 

0037 

0038 

0039 

0040 

0041 

0042 

0043 


SUBROUTINE  GRIDS 

*******  **************************************************  ******* 
*  THIS  ROUTINE  JUST  DRA*S  THE  10KM  GRID  SQUARES.  * 

**************************************************************** 
IMTEGER*2  IX,IY,IMAX 
INCLUDE  '*INDJ.CMN' 

I  *********  ********************************************  ********* 

1  *  FulNXY  CONTAINS  THE  X  MIN  AND  MAX  AND  THE  Y  MIN  AND  « 

1  *  MAX  RESPECTIVELY  FOR  THE  HINDU*.  MIN  AND  MAX  REFER  * 

1  *  TO  THE  MIN  ANO  MAX  OF  ELEVATION  VALUES ,  AND  ZDELT  IS  * 

1  *  THE  CONTOUR  INTERVAL.  « 

1  ************************************************************** 

1  DIMENSION  FWIMXYC 4) 

1  COMMON/* INDO/FWINXY, MIN, MAX, ZDELT 

1  ************************************************************** 
CALL  CMJPEN 
GRSIZE=10000. 

Y8=FWINXY(3) 

YT=F*INXY(4) 

CALL  LINCLRC4) 

DO  XL=F*INXY(1),F*INXY(2),GRSIZE 
CALL  MJVE(XL,YB) 

CALL  DRArt(XL,YT) 

IFCAMODIXL, 10000.) .EO.O.JTHEN 
C.....  REORA*  THE  GRID  LINE 

CALL  MOVE(XL+50. ,YB) 

CALL  DRA*(XLt50.*YT) 

ENDIF 

ENDOO 

XLsFHINXY(l) 

XRsF* IN  X Y ( 2 ) 

DO  YBsF*lNXY(3) ,FWINXY(4) ,GRSIZfc 
CALL  MOVE(XLfYB) 

CALL  DRA* ( XR , YB) 

IF(AMOO(YB, 10000.) .EO.O.JTHEN 

C .  REDR  A*  THE  GRID  LINE 

CALL  HOVE(XL,YB+50.) 

CALL  D8Am(XR,YB+50.> 

ENDIF 

ENDOO 

C  CALL  NUMBK 

CALL  CMCLJS 
RETURN 


H  A  2 1 J  5* 


ao  5  a 

C 

♦initiauIze  i,j  coordinates  to  o 

0050 

1  =  0 

0050 

J  =  0 

0061 

c 

♦  IF  (HEX  ADOkESS  IS  ?0S  T  T  I  V  F  )  THEN 

0062 

if(haor.le.O)  goto  1300 

0063 

c 

♦INITIALIZE  LEVEL  fO  MAXIMUM  NUMbEK  OF  HEX  LEVELS 

0064 

LEV  =  NHLc.V 

0065 

c 

♦  GET  LEAST  SIGNIFICANT  (HIGH  MOST )  HEX  DIGIT 

0066 

HEX  =  HAuR 

0067 

Hl)IG  =  I A  ND(  HEX  ,  7  ) 

0060 

c 

♦LOOP  UNTIb(N0  MORE  HEX  DIGITS) 

0069 

1100 

co  i  n nue 

0070 

c 

♦DECREMENT  LEVEL  8Y  OnE 

'0071 

LEV  =  LEV  -  1 

0072 

c 

♦SHRINK  PREVIOUS  I,J  VECTdR  8(  ONE  LEVEL 

0073 

IN EH  =  (j*I  -  J ) / 7 

0074 

JNEH  s  ( I  +  J  +  J ) / 7 

0075 

c 

* AOO  I,J  VECTOR  CORRESPONDING  TO  CURRENT  HEX  013IT 

0076 

I  =  INEW  +  IHAX(HDIG) 

0077 

J  s  JNEW  *  JMAX(HOIG) 

0078 

c 

♦GET  NEXT  HEX  OIGIT 

0079 

HEX  a  ISHFT ( HEX , -3 ) 

0080 

HDIG  =  IAN0(H£X,7) 

0081. 

c 

*ENDLOOP(HEX  DIGIT  LOOP) 

'  0082 

IF(HOIG.NE.O)  GOTO  1100 

0083 

c 

*IF( LEVEL  OF  HEX  ADDRESS  IS  INVALID) THEN 

0084 

IFCbEV.GE.MINbEV)  GOTO  1200 

0085 

c 

*INCLUDE(GENERATE  HEX  ERROR  MESSAGE  -  HXERR) 

0086 

CALL  HXERR(6HHA2I JM,2,HAdR,LEV,0,0) 

008  1 

c 

*ENOIF'(LEVEL  CHECK) 

0088 

1200 

CONTINUE 

0089 

c 

*ELSE( HEX  AODRESS  IS  nO T  POSITIVE) 

009O 

GOTO  1400 

0091 

1300 

CONTINUE 

0092 

c 

♦SET  RETURN  LEVEL  TO  ZERO 

0093 

LEV  =  0 

0094 

c 

♦INCLUDECGENERATE  HEX  ERROR  MESSAGE  -  HXERR) 

0095 

CALL  HXERR(6HHA2IJM, 1 , HADK,0,0,o) 

0096 

c 

*ENOIF(CHECK  FOR  POSITIVE  HEX  ADDRESS) 

0097 

1400 

CONTINUE 

0098 

c 

*ENDR0UTINE(HA2I JM) 

-0099 

RETURN 

01 00 

END 
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S  JBROUTlHE  HA 2X YL ( H ADR, X, Y, LEV) 

*rtJ(irirte(CJMVEi<r  HEX  ADDRESS  TO  X,Y  COORDINATES  AN 0  I.EVEL-HA2XYL) 

♦ 

*  OESIGNER/PROGRAMMER: 

o  DON  KRECKt-R  21  SEPTEMBER  1980 

*  PURPOSE: 

*  HA2XYL  CONVERTS  A  HEX  ADDRESS  TO  THE  X,Y  CARTESIAN  COJRDI- 

*  NATES  OF  THE  CENTER  OF  THE  HEX  AND  THE  LEVEL.  OF  AGGREGATION 

*  OF  I H £  HEX.  THE  X,Y  COORDINATES  ARE  EXPRESSED  IN  METERS. 

*  THIS  ROUTINE  IS  THE  INVERSE  OF  THE  SU3RQU  TINE  XYL2HA. 

*  HA2XYL  FIRST  CALLS  THE  ROUTINE  RA2IJM  TO  CONVERT  THE  HEX 

*  ADDRESS  TO  EQUIVALENT  I,J  OesLIQuE  COORDINATES  AT  THE  MI«I- 

*  MUM  HEX  LEVEL  AND  TO  RETURN  THE  LEVEL  OF  THE  GIVEN  HEX. 

*  error  Checking  is  done  in  this  subordinate  routine,  then 

*  The  I,J  COORDINATES  ARE  CONVERTED  TO  X,*  COORDINATES  IN 

*  METERS  aY  CALLING  THE  ROUTINE  IJM2XY. 

*  CALLING  SEQUENCE: 

*  CALL  HA2X<L(HADR,X, Y,LEV) 

*  input: 

*  HADK  -  HEX  ADDRESS  FOR  WHICH  THE  EQUIVALENT  X,Y  C30RDI- 

*  NATES  AND  LEVEL  UF  AGGREGATION  ARE  TO  BE  COMPUTED 

*  OUTPUT: 

*  X ,  Y  -  REAL-VALUED  CARTESIAN  COORDINATES  OF  THE  CENTER 

*  OF  THE  GIVEN  HEX  EXPRESSED  IN  PETERS 

*  LEV  -  LEVEL  OF  AGGREGATION  OF  THE  GIVEN  HEX  ADDRESS 

t*«t******«*****f*«y **********  ****************************  ******** 

IMPLICIT  INTEGER(H,P) 

♦INCLUDEICONVERT  HEX  ADDRESS  TO  MIN  LEVEL  I,J  AND  LEVEL-H A21 JM ) 
CALL  HA2I JMIHADR, I, J,LEV) 

*lNCLUD£(COiNVERT  MIN  LEVEL  I,J  TO  X,Y  COORDINATES  - 
CALL  IJM2X: ( I , J,X, Y) 

♦ENDR0UTINECHA2XYL) 

RETURN 


I JM2XY) 


0001 

0002 

0003 

0004 

0005 

000b 

0007 

0008 

0009 

0010 

0011 

0012 

.0013 

0014 

0015 

0016 

0017 

0018 

0019 

0020 

0021 

0022 

0023 

0024 

0026 

002o 

0027 

0028 

0029 

0030 

0031 

0032 

0033 

0034 

0035 

003b 

0037 

0038 

0039 

0040 

0041 

0042 

0043 

0044 

0045 

0046 

0047 

0048 

0049 

0050 

0051 

0052 

0053 

0054 

0055 

005b 

0057 


1100 


SUBROUTINE  HEXlN(riREAO,IBASE,LEVEL,HSrOR) 

♦ROUTINE!  CONSTRUCT  INTERNAL  HEX  ADDRESS  -  HEXIN) 

*  DESIGNER/PkGGRA.'MERS 

*  DON  KRECKER  10  SEPTEMBER  1980 

*  PURPOSES 

*  HEXIN  TAKES  AN  [MPUi  HEX  QUANTITY  IN  EITHER  OCTAL  OR 

*  DECIMAL  REPRESENTATION  AND  CONSTRUCTS  A  HEX  ADDkESS  AT 

*  THE  REQUESTED  LEVEL  IN  THE  REQUIRED  INTERNAL  FORMAT. 

*  THE  INPUT  HEX  QUANTITY  IS  TREATED  AS  A  HEX  VECTOR  FROM 

*  THE  ORIGIN  OF  THE  HEX  COORDINATE  SYSTEM,  AND  THEREFORE 

*  THE  PRESENCE  OR  ABSENCE  OF  LEADING  7  HEX  DIGITS  PLAYS 

*  NO  ROLE.  THE  RETURN  HEX  ADDRESS  *  I LL  CONTAIN  LEADING  7 

*  HEX  DIGITS  AS  NEEDED  TO  INDICATE  THE  REQUESTED  HEX  LEVEL. 

*  THE  NUMBER  OF  LEADING7  HEX  DIGITS  DEPENDS  ON  THE  NUMBER 

*  OF  LEVELS  OF  HEX  AGGREGATION  IN  USE  IN  THE  CURRENT  CON- 

*  FIGURATION,  AS  INITIALIZED  IN  A  DATA  STATEMENT.  HEXIN 

*  ALSO  CHECKS  FOR  INVALID  INPUTS.  IN  THE  CASE  OF  AN  ERROR, 

*  AN  ERROR  MESSAGE  IS  PRINTED,  AND  THE  RETURN  HEX  ADDRESS 

*  IS  SET  TO  ZERO. 

***************************************************************** 

*  CALLING  SEQUENCES 

*  CALL  HEXlN(HREAD, IB ASE , LEVEL, HS TOR) 

*  INPUTS 

*  HREAD  -  HEX  QUANTITY  AS  READ  IN  EITHER  OCTAL  OR  DECIMAL 

*  REPRESENTATION,  with  OR  VITHUUT  LEADING  7  DIGITS 

*  IBASE  -  FLAG  INDICATING  THAT  HREAD  IS  IN  OCTAL  (0)  OR 

*  DECIMAL  (1)  REPRESENTATION 

*  LEVEL  -  LEVEL  OF  HEX  ADDRESS  TO  BE  CONSTRUCTED 

*  OUTPUT: 

*  HS  TOR  -  tiEX  ADDRESS  AT  REQUESTED  LEVEL  IN  REQUIRED 

*  INTERNAL  FORMAT,  OR  ZERO  IF  ANY  ERRORS  OCCURRED 

****************************************************************** 
IMPLICIT  I N  TEGER (  H  ,  P ) 

♦OUTPUT  DEVICE  NUMBER  CONSTANT 
DATA  IR  T/b/ 

♦NUMBER  OF  LEVELS  OF  HEX  AGGREGATION  CONSTANT 
DATA  NHEXLV/10/ 

♦MINIMUM  HEX  LEVEL  CONSTANT 
DATA  MTNHLV/  2/ 

•INITIALIZE  RETURN  HEX  ADDRESS  TO  ZERO 
HS  TOR  =  0 

♦IF (VALID  LEVEL  AND  POSITIVE  HEX  QU AN T ITY ) THEN 
IFCLCVEL.LI. MlNHLV)  GOTO  1800 
IF(LEVEL.GE.NHEXLV)  GOTO  180U 
IF( HftEAO. LE . u )  GOTO  1800 

♦INITIALIZE  MULTIPLIER  CORRESPONDING  TO  OCTAL  OR  DECIMAL 
MULT  s  2 * IBASE  ♦  8 

♦CALCULATE  MAXIMUM  SHIFT  CONSTANT  AS  FUNCTION  OF  LEVEL 
MSHIFT  =  3*( NHEXLV-LEVEb) 

♦INITIALIZE  PARAMETERS  FOR  DIGIT  LOOP 
HLOC  s  HREAD 
LSHIFT  =  j 

•LOOP  UNTILCALL  DIGITS  CHECKED  OR  INVALID  DIGIT  FOUNO) 
CONTINUE 

♦STRIP  OFF  NEXT  DIGIT 
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» ' 

.N 

L: 

9 

HEX  IN 

V 

o  0058 

HTMP  =  HLOC/MULT 

•J 

1 

rai  0059 

80 1 3  =  HliOC  -  HTMPMULT 

fci 

ji  0060 

c 

♦1F( DIGIT  LIMIT  NOT  EXCEEDED ) THEN 

P 

Q  0061 

IF(LSHIFT.GE.MSHIFT)  GOTO  1400 

0  0062 

c 

♦IF(UIGIT  IS  A  VALID  HEX  OIGIT)THEN 

y  0  06  J 

y  0064 

c 

IF(HDIG.£0.0. JR.rtuIG.GT.7)  GOTO  1200 
*  INSERT  DIGIT  IN  OUTPUT  HEX  ADDRESS 

|  0065 

rtSTOR  s  IOR(HSTOR,lSHFf (HDIG,LSH1FI ) ) 

- 

1  0066 

c 

♦ELSE ( DIGIT  IS  INVALID) 

■ 

0067 

GUT J  1300 

V  0068 

1200 

CONTINUE 

:/  0069 

c 

♦SET  RETURN  HEX  ADDRESS  TO  ZERO 

y  oo7o 

HSTOR  =  0 

]  0071 

c 

♦ENDIF ( HEX  DIGIT  VALIDITY  CHECK) 

i 

9  0072 

1300 

CONTINUE 

0  007  J 

c 

♦ELS£( DIGIT  LIMIT  EXCEEDED) 

$  0074 

GOTO  1600 

’• 

<  0075 

1400 

CONTINUE 

v  0076 

c 

♦1FCHEX  DIGIT  NOT  7 ) THEN 

*- 

Jj  0077 

IF ( HOIG.EQ. 7 )  GOTO  1500 

j 

i 

9  0078 

c 

♦SET  RETURN  HEX  ADDRESS  TO  ZERO 

0079 

HSTOR  s  0 

i*‘.  0080 

c 

♦ENOIFCCHECK  FOR  7  HEX  DIGIT) 

oo8i. 

1500 

CONTINUE 

?!  0082 

c 

♦ENOIF (DIGIT  LIMIT  CHECK) 

|  0083 

1600 

CONTINUE 

i 

1  0084 

C 

♦UPDATE  LOOP  PARAMETERS  FOR  NEXT  DIGIT 

0085 

HLOC  s  HTMP 

. 

3  0086 

LSHIFT  s  LSHIFT  ♦  3 

♦ 

'i  0087 

A  0088 

c 

♦ENOLOJP( DIGIT  LJOP) 

\ 

IF(HLJC.NE.O. AND. HSTOR. NE.O)  GOTO  1100 

/ 

i  0089 

c 

♦  I F  (  N  0  ERROR  AND  LEADING  7  HEX  DIGITS  NEEDED ) THEN 

ji  0090 

I F ( HSTOR , EQ. 0 )  GOTO  1700 

i 

6  0091 

IF( LSHIFT. GE.MSHIFT)  GOTO  1700 

« 

0092 

c 

♦SET  UP  REQUIRED  LEADING  7  DIGITS 

§  0093 

dDIG  s  ISHFT( 1 ,M SHIFT- LSHIFT)  -  1 

* 

» 

*  0094 

c 

♦INSERT  DIGITS  IN  OUTPUT  HEX  ADDRESS 

*  0095 

HSTOR  3  IORCHSTOR, ISHFT(HDIG, LSHIFT) ) 

U 

fl  0096 

c 

♦ENDIF( ERROR  AND  LEADING  7  HEX  DIGIT  CHECK) 

1 

y  0097 

1700 

CONTINUE 

,*« 

0098 

c 

♦ENDIF( VALID  LEVEL  AND  POSITIVE  HEX  QUANTITY  CHECK) 

.  % 

0099 

1800 

CONTINUE 

^  0100 

c 

♦IF( ANY  ERRORS) THEN 

“  0101 

IF(HSTOR.NE.O)  GOTO  1900 

1*  0102 

c 

♦WRITE  ERROR  MESSAGE 

1. 

0103 

IF( XBASE. NE.O)  GOTO  1810 

.** 

* 

%  0104 

NRITE(IRT,900l)  HREAD, LEVEL 

%  0105 

GOTO  1920 

5  0106 

1810 

CONTINUE 

< 

£  0107 

i  0108 

1820 

8RITE(1RT,9Q02)  HPEAO, LEVEL 

CONTINUE 

' 

;  0109 

C 

♦ENOIF(ERROR  CHECK) 

-1 

0110 

1900 

CONTINUE 

' 

'  0111 

RETURN 

. 

*  0112 

9001 

FORMA  T  (  //  42H  ♦♦♦♦♦  iNVALi  P'.RAMETERS  IN  HEXIN  ♦♦♦♦♦/ 

y 

* 

2  0113 

♦ 

21H  OCTAL  HEX  NUWbER  3,010/ 

P  0114 

♦ 

32H  REQUESTED  HEX  ADDRESS  LEVEL  *fH0//) 

B 

Y 

B-162 

HEX  I  N 


0115  9002  F  JR  MA  T(  / /  42.1  *****  INVALID  PARAMETERS  IN  HEXIN  ♦ 

0l\.b  f  23H  DECIMAL  HEX  NUMBER  =,110/ 

9117  ♦  32H  REQUESTED  HEX  ADDRESS  LEVEL  =,I10//J 

0110  END 


B-163 


0001  SUBROUTINE  riEX2XY(H£X,X,Y) 

0002  *******  ******** ********************************** ************* 

0003  *  THIS  SUBROUTINE  IS  USED  TO  TRANSLATE  AN  INTERNAL  HEX  * 

0004  *  ADDRESS  TO  STANDARD  UTN  COORDINATES.  * 

ooos  ************************************************************** 

0006  IMPLICIT  I N  TEGER ( H  ,  P) 

0007  INCLUDE  'CENTER.CMN' 

0008  1  *********************************************************** 
0009  1  *  THE  CENTER  OF  THE  H£X  GRID  IS  AT  XORIG IN , YORIGI N  * 

0010  1  *  WHERE  THE  COORDINATES  ARE  IN  METERS  UTM  RELATIVE  * 

0011  1  *  TO  A  GIVEN  GRID  ZONE.  * 

0012  1  *********************************************************** 
0013  1  I.MTEGER*4  XORIGIN ,  YORIGIN 

0014  1  COMMON/CENTER/XORIGIN, YORIGIN 

0015  1  DATA  XORIGIN/50Q0Q0/, YORIGIN/5700000/ 

0016  1  C********************«*********************************** 

0017  CALL  HA2XYL(HEX,X,Y,L£V) 

0018'  C  D  PRINT*, 'LEV  IN  HEX2XY :  ',LEV 

0019  X=X+XORIGIN 

0020  Y=Y*Y0RIGIN 

0021  RETURN 


64 


0010 

0011 

0012 

0013 

0014 

0015 

bolb 

0017 

0018 

0019 

0020 

0021 

0022 

0023 

0024. 

0025 

0026 


00  30 
0031 
0032 
0033 
0034 
0035 
003b 
0037 
0038 
0039 
0040 
0041 
0042 
0043 


SUBROUTINE  HEXlNli 

**************************************************************** 

*  THIS  JUST  KEEPS  ALL  OF  THE  HEXINIT.PRM  JUNK  OUT  OF  THE  * 

*  MAIN  ROUTINE.  WHILE  INITIALIZING  THE  HEX  PARAMETERS.  * 

**************************************************************** 

I mCLUUE  'hEX.CMN' 

l  ********************************************************************** 

1  *  FOR  DEFINITIONS  OF  VARIABLES  SEE  HXINIT.FOR  * 

1  ********************************************************************** 
i  implicit  integeh(h,p) 

1  CJMW0N/3EX/IHX0UT,NriLEV,MINLEV,SLT0,CLr0,DLN0,DIAM( 10) ,DIAMTR, 

1  AOFl,YJFI ,XOFJ,  YuFJ,RIDFX,RJOFX,RIOFY,RJOFY , 

1  ♦  ICON(7o) , JC0NI70) , IMAX(7) , JMAX(7) 

1  ********************************************************************** 
INCLUDE  'HEXRAD.CMN' 

1  IN  TEGER*2  DbRES, HEXR 

1  COMMON / HEXR AD/DBRfcS, RAD 2, HEXR 

**************************************************************** 

*  iwrite:  output  device  for  ERROR  MESSAGES  * 

*  LEVMAX S  MAXIMUM  LEVEL  OF  HEX  AGGREGATION  * 

*  levmin:  minimum  ■  ■  ■  * 

*  DLTJ  LATITUDE  OF  THE  ORIGIN  HEX  IN  FLOATING-  * 

*  POINT  DEGREES  * 

*  DLN :  LONGITUDE  OF  ORIGIN  HEX  * 

*  LEVSIZ:  HEX  LEVEL  AT  WHICH  THE  SCALE  OF  THE  * 

*  HEX  COORDINATE  SYSTEM  IS  GIVEN  * 

*  SIZHEX:  DIAMETER  OF  HEXES  AT  SIZE  'LEVSIZ'  IN  ♦ 

*  FLOATING-POINT  METERS  * 

IWRITS=6 

LEVMAX=9 

LEVMIN=4 

DLT=51.45  i  LAT  AND 
QLN=9.00  !  LON  OF  32UNC00 

LEVSIZsb 
SIZH£X=25 JOO. 

CALL  HX  INI  T(  I  *RITE ,  LEVM  AX  ,LEVMIN,DLT,  DLN,  LEVSIZ,  SIZHEX) 
**************************************************************** 
DBRESslOO  'DATA  BASE  RESOLUTION 

*  THE  TRUE  RADIUS  OF  A  3.57  KM  HEX  IS  2061, BUT... 

HEXRS2000 

R=HEXR  ! HEXR  OVERFLOWS  WHEN  IT  IS  SQUARED 

RAD2sR**2 

return 


I. 


0001 

000  2  C 

>003  c 

0004  C 

0005  C 

)00b  c 

0007  C 

0008  C 

0009  C 

00 10  C 

0011  c 

0012  C 

0013  C 

0014  C 

0015  C 

00  lb  C 

0017  C 

0018  C 

0019  C 

0020  C 

0021  C 

0022  C 

0023  C 

0024-  C 

0025  C 

002b  C 

0027  C 

0028 

0029  1  **•♦* 

0030  1  * 

0031  1  ***** 

0032  1 

00  J3  1 
0034  1 

0035  1 

003b  1  ***** 

0037  C 

0030 

0039  C 

0040 

0041  C 

>042 

0043  C 

7044 

>045  C 

3046 

0047  C 

>048 

>049  C 

0050 

0051  C 

>052 

0053  C 

7054 

0055  C 

305b 

>057  C 


subroutine;  HEXOUT(HoTjR,  I8ASE,HwRYT) 

RJUrinE(  FORMAT  hex  address  FOR  OUTPUT  -  HEXOUT) 

***************************************************************** 

OESIGNER/PROGRAMMEk: 

DON  KRECKER  11  SEPTEMBER  1980 
PURPOSE: 

HEXJUr  TAKES  A  HEX  ADDRESS  IN  INTERNAL  FORMAT  AND  REFORMATS 
IT  FOR  OUTPUT.  IF  REQUESTED,  THE  HEX  ADDRESS  IS  CONVERTED 
FROM  OCTAL  TO  DECIMAL  REPRESENTATION.  LEADING  7  HEX  DIGITS 
ARE  APPENDED  TO  THE  ADDRESS  SO  THAT  IT  IS  IN  STANDARD  FORM 
BASED  ON  12  LEVELS  OF  HEX  AGGREGATION.  THE  NUMBER  OF  LEAD¬ 
ING  7  HEX  DIGITS  TO  BE  APPENDEO  DEPENDS  On  THE  NUMBER  OF 
LEVELS  OF  HEX  AGGREGATION  IN  USE  IN  THE  CURRENT  CONFIGURA¬ 
TION,  AS  INITIALIZED  IN  A  DATA  STATEMENT. 

CALLING  SEQUENCE: 

CALL  HEXOUT(HSTOR,IBASE,HWRYT) 

input: 

HSTOR  -  HEX  ADDRESS  IN  INTERNAL  FORMAT 

TBASE  -  FLAG  INDICATING  THAT  REQUESTED  OUTPUT  FORMAT  IS 
OCTAL  (0)  OR  DECIMAL  (1) 

JUTPUT: 

HWRTT  -  HEX  ADDRESS  IN  REQUESTED  OUTPUT  FORMAT,  EITHER 
JCTAL  OR  DECIMAL,  WITH  STANDARD  LEADING  7  HEX 
DIGITS  APPENDED 

***************************************************************** 
INCLUDE  #HEX.CMN# 

********* ********************** **********************  *********** 
FOR  DEFINITIONS  OF  VARIABLES  SEE  HXINIT.FOR  * 

**************************************************************** 

IMPLICIT  I  N  i’EGER  (  H ,  P ) 

CJMMON/HEX/IHKOUT,NHLEV,MINLEV , SLTO , CLIO , DLNO , DI AM ( 10) , DI AMTR, 
XOFI, YOFI,XOFJ,TUFJ,KIOFX,RJUFX,RIOFY,RJOFT, 

ICON (70) ,JC0N(70) ,IMAX(7> ,JMAX(7) 

**************************************************************** 

OUTPUT  DEVICE  NUMBER  CONSTANT 
DATA  IRT/b/ 

NUMBER  OF  LEVELS  OF  HEX  AGGREGATION  CONSTANT 
DATA  NHEXLV/10/ 

MINIMUM  HEX  LEVEL  CONSTANT 
DATA  MIMHLV/  If 

•INITIALIZE  RETURN  HEX  ADDRESS  TO  ZERO 
HWKTT  =  J 

*  I F ( POS I Tl V£  HEX  AODRESS ) THEN 
IF (HSTOR . L£ . 0 )  GOTO  1400 

•COMPUTE  NUMBER  OF  DIGITS  IN  HEX  ADDRESS 
ND1G  s  I FIX ( 0 . 490898 *ALOG( FLO ATI HSTOR ) ) )  ♦  1 
•IF (VALID  NUMBER  OF  DlGI TSJTHEN 
IFCND13.GT.NHEXLV-MINHLV)  GOTO  1300 

•SET  UP  LEADING  7  DIGITS  TO  BE  APPENDED 
HDIG  *  ISHFT(1,3*(12-NHEXLV)>  -  1 
•CONSTRUCT  OUTPUT  HEX  ADDRESS  IN  OCTAL  FORMAT 
HNRT T  a  10R(HST0K,ISHFT(HDIG,3*NDIG) ) 

*IF(DECIMAL  FORMAT  REQU£ST£D)THEN 
IF( IBASE.EJ.O)  GOTO  1200 

•INITIALIZE  CONVERSION  LOOP 
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hexuut 


0058 

0050 

)06o 

0061 

0062 

0063 

0064 

4065 

006b 

0067 

0068 

0069 

0070 

0071 

0072 


1100 


C 

c 

c 


c 

c 


HLOC  =  H*RYT 
HaRYT  =  0 
IPOwR  a  1 

♦LOOP  UNTIL (ALL  DIGITS  CONVERTED) 

CONTINUE 

♦STRIP  OFF  NEXT  DIGIT 
HDIG  s  I  AN  D ( HLOC » 7  ) 

♦APPEND  DIGIT  TO  OUTPUT  HEX  ADDRESS 
HNRYT  =  H*RYT  ♦  iPOrfR^HOIG 
♦UPDATE  LOOP  PARAMETERS  FOR  NEXT  DIGIT 
tiLOC  s  ISHFT(HLUC,-3) 
iPUWR  s  IPQWR^IO 
♦£NDLOOP( DIGIT  CONVERSION  LOOP) 
IF(nLOC.GT.O)  GOTO  1100 
♦ENDIFCDECIMAL  FORMAT  CHECK) 


0073 

1200 

CONTINUE 

0074 

C 

♦ENDIFCOIGIT 

0075 

1300 

CONTINUE 

007b- 

c 

♦ENOIFIPOStriVE 

0077 

1400 

CONTINUE 

0078 

1500 

CONTINUE 

0079 

RETURN 

0080 

9001 

FJR*AT(//44d  ♦♦♦♦ 

0081 

♦  35H  HEX 

0082 

E*«0 

COUNT  CHECK) 


HEX  ADDRESS  CHECK) 


‘  INVALID  HEX  ADDRESS  IN  HEXOUT  ♦♦♦♦♦/ 
ADDRESS  IN  INTERNAL  FORMAT  s,012//) 


0001 

SO rtriOUT X *9 E  HEXREAO (HS TOR, SI DES,LU) 

0002 

C****************************** ************** 

OOOJ 

c***** 

this  routine  is  designed  ro  read  the 

0004 

c ***** 

HEX  NUMBER  AND  COHN£C f I V 1 f i  OF  ITS 

0O05 

c***»* 

SIDES  FROM  THE  FILE  'HEXRQAQ.DAT' 

0006 

C********************** *********************** 

0007 

c 

0000 

IMPLICIT  I  INTEGER  ( H ,P) 

0009 

INTEGERM  SIDES 

0010 

c 

0011 

CALL  H£XOUT(HSTOR, 1 ,HEX) 

0012 

R£AD(UNIT=LU,KE7=HEX»KE7ID=0,I0STAT=I0S 

0013 

,£RRs999)  HEX, SIDES 

0014 

CALL  HEXlN(HEX,l,4,rlSTQR) 

0015 

c 

0016 

c 

IF  ALL  v,OES  4 t,LL •  •  • 

0017 

RETURN 

0018 

c 

0019 

c 

IF  NOT... 

0020 

999 

CONTINUE 

0021 

C 

ERROR  COOE  36  IS  RETURNED  ON  AN  ATTEMPT  TO 

0022 

c 

REAO  A  NONEXISTANT  RECORD.  (AND  MAYBE  FOR 

0023 

c 

OTHER  REASONS, TOO. ) 

0024 

c 

0025- 

SIDESaO 

0026 

IFUOS.EQ.36)  THEN 

0027 

WRITE(UNir=LU) HEX, SIDES 

0028 

ELSE 

0029 

CALL  LI3$SIGNAL(%VAL(I0S)) 

0030 

EMOIF 

0031 

return 

0032 

END 

SUBROUTINE  HEXWRITE(HSTJR, SIDES, LU) 

c** *******************************  *********** 

C*****  THIS  ROUTINE  IS  DESIGNED  TO  WRITE  THE 
C*#***  H£X  NUMBER  AND  THE  CONNECTIVITY  OF  ITS 
C ♦♦***  SIDES  TO  THE  FILE  'HEAR 'J  AD. DAT*. 

Z****** ************************  *************** 

C 

IMPLICIT  INTEGER  (H,P) 

I NTEGER *4  SIDES 
C 

CALL  UEXOUTCHSTOR, 1 ,HEX) 

ARITE(UNI fsLU,IOS TAT* IQS, ERR=999) HEX, SIDES 
C 

C  IF  ALL  GOES  HELL... 

RETURN 

C 

C  IF  NOT... 

999  CONTINUE 

IF(IOS.EQ.SO) THEN 

CALL  HEXREAD(HSTOR,ISIDES,LU) • tSIDES  IS  A  DUMMY 
REwRI TECUM  I T  =  LU)HEX, SIDES 
ELSE 

CALL  LId$SIGNAL(%YAL(IOS) ) 

E.NDIF 

RETURN 

END 


0001 

0002 

0003 

0004 

0005 

0006 

0007 

0000 

0009 

0010 

0011 

0012 

0013 

0014 

0015 

0016 

0017 

0018 

0019 

0020 

0021 

0022 

0023 

0024- 

0025 

0026 

0027 

0028 

0029 

0030 

0031 

0032 

0033 

0034 

0035 

0036 

0037 

0038 

0039 

0040 

0041 

0042 

0043 

0044 

0045 

0046- 

0047 

0048 

0049 

0050 

0051 

0052 

0053 

0054 

0055 

0056 

0057 


C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


c 


c 

c 

1100 

c 


INTEGER  FUNCTION  HXADQ(HEXA,HEXd) 

RJUriNE(ADD  TwO  OCTAL  HEX  NUMBERS  -  HX ADO ) 

***************************************************************** 

DESIGNER/PkOGRAMMER: 

DON  KkECKER  11  SEPTEMBER  1980 
PURPOSE: 

HXAOD  adds  two  HEX  numbers  expressed  in  octal  representa¬ 
tion.  THE  ALGORITHM  FIRST  ADDS  COLUMNS  OF  HEX  DIGITS  IN 
PARALLEL  TO  GET  HEX  SUM  DIGITS.  THE  CORRESPONDING  HEX 
CARRY  DIGITS  ARC  THEN  CALCULATED  USING  LOGICAL  OPERATIONS. 
IF  NOT  ALL  CARRY  DIGITS  ARE  ZERO,  THEY  ARE  SHIFTED  ONE 
COLUMN  UEFT  ANO  TREATED  AS  A  NEw  ADDEND  TO  BE  ADDED  TO  THE 
SUM  OIGITS.  THE  PROCEDURE  CONTINUES  UNTIL  NO  NEW  CARRIES 
ARE  GENERATED.  IF  N  IS  THE  MAXIMUM  NUMBER  OF  HEX  DIGITS 
IN  EITHER  ADDEND,  THE  ALGORITHM  8 ILL  TERMINATE  IN  AT  MOST 
N+l  STEPS.  THE  HEX  SUM  MILL  CONTAIN  N  OR  N+l  HEX  DIGITS, 
AND  ANY  N+1ST  HEX  DIGIT  WILL  NOT  BE  A  7. 

GIVEN  A  PAIR  OF  HEX  DIGITS,  HA  AND  HB,  THEIR  HEX  SUM  OIGIT 
IS  CALCULATED  BY  AODITION  MODULO  7  WITH  THE  RESULT  IN  THE 
RANGE  1  THROUGH  7  (RATHER  THAN  0  THROUGH  6). 
HSUN(HA,HB)=HA*HB(MOD  7) 

THE  CORRESPUNOING  HEX  CARRY  DIGIT  IS  CALCULATED  BY  A  SERIES 
OF  LOGICAL  OPERATIONS. 

HCAR(HA,HB)=XOR(OR(HA,HB) ,AND(XOK(HA,HB) ,HSUm(HA,HB) ) ) 

IN  SOME  INSTANCES  THIS  FORMULA  WILL  GIVE  A  CARRY  DIGIT 
OF  7  WHICH  MUST  BE  RESET  TO  0. 

CALLING  SEQUENCE: 

HXAOD  s  HXADD(H£XA,HEX8) 

input: 

HEXA  -  FIRST  HEX  NUMBER  TO  BE  ADDED 
HEXB  -  SECOND  HEX  NUMBER  TO  BE  ADDED 
OUTPUT: 

HXADD  -  HEX  SUM  OF  HEXA  AND  HEXB 

************  *******  mm*  *****************************  ********** 
IMPLICIT  INTEGER(H,P) 

MASK  OF  OCTAL  1  DIGITS 
DATA  Ml/'ltllllllll'O/ 

MASK  OF  OCTAL  3  DIGITS 
DATA  M3/' 3333333333*0/ 

MASK  OF  OCTAL  4  OIGITS 
DATA  M4/' 4444444444*0/ 

*  INITIALIZE  ADDENDS  AS  LOCAL  VARIABLES 
HA  s  HEXA 
hB  s  HEXB 

♦GENERATE  MASK  OF  SIGNIFICANT  HEX  DIGIT  POSITIONS 
LOR  s  I3R(HA,H8) 

LOR  3  =  I  AND ( LOR , M3 ) 

MOIG  =  IAN0(I0R(LQR3+M3,L0R),M4) 

♦SET  UP  HEX  OIGIT  7  IN  NEXT  MOST  SIGNIFICANT  POSITION 
HCHK  *  (MOIG  -  ISHFT(MjIG,-3))  ♦  14 
♦LOOP  UNTIL( NO  HEX  CARRIES  TO  BE  ADDED  IN) 

CONTINUE 

♦  EVALUATE  BASIC  .-ICAL  FUNCTIONS  OF  ADDENDS 

LOR  *  I  OR  (  H  A  ,  iid ) 

L0R3  s  I  AND ( LOR , M3) 
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HXAOO 


0058 

0059 

0060 

0061 

0062  C 
0063  C 
0064 

0065  C 

006b 

0067  C 

*0068 

0069  C 

.0070  C 

0071  C 

0072 

0073  C 

0074 

0075  C 

0076 

0077  C 

0078  C 

0079 

0080  C 

0081. 

0082  C 

0083 

0084  C 

0085 

0086  C 

0087 
0088 


LAND  =  1  ANLKriA,  Hb) 

LAN04  =  IAND(LAN0,H4) 

LECR  z  Ic.OR(bA,HB) 

LEOK4  z  IANCK  LE3R,M4) 

♦♦compute  hex  sum  digits 

♦ADO  DIGITS  IN  EACH  COLUMN  MODULO  8  (NO  COLUMN  OVERFLOWS) 
HA  z  I E  0  R ( 1ANO(HA#M3)+IAnD(HB,M3) , L  E  3  R  4 ) 

♦GENERATE  MASK  OF  columns  WHICH  OVERFLOW  aHEN  ADDED 
MDIG  z  I0R(IAND(LE0R4,N0T(HA) ) , LAND4 ) 

♦INCREMENT  COLUMNS  WITH  OVERFLOW  TO  GET  SUM  MODULO  7 
HA  z  HA  +  XShFT(MDIG,-2? 

♦♦END  HLOCK(COMPUTE  HEX  SUM  DIGITS) 

♦♦COMPUTE  HEX  CARR I  DIGITS 

♦COMPUTE  GENERALISED  CARR*  OIGITS  (POSSIBLY  WITH  7S) 

HB  z  I£OK(LOR,IAND(LEOR,HA)) 

♦GENERATE  MASK  UF  COLUMNS  GIVING  CARRY  OIGIT  7 
MDIG  z  IAND(IAND(L0R,L0K3+M1)#MDIG) 

♦RESET  CARRY  DIGITS  7  TO  0 
HB  z  I£QR(HB,ISHFT(MDIG#“2)*7) 

♦♦END  BLOCK ( COMPUTE  HEX  CARRY  DIGITS) 

♦SHIFT  CARRY  OIGITS  ONE  COLUMN  LEFT  TO  FORM  ME*  ADDEND 
HB  z  1 SHF T( HB , 3 ) 

♦ENDLOOP(ADDITION  UNTIL  NO  MORE  CARRIES  LUOP) 

IF(HH.NE.O)  GOTO  1100 

♦REMOVE  EXTHAmEJUS  LEADING  7  FROM  SUM  IF  PRESENT 
IF(HA.GT.HCHK)  HA  z  HA  -  HCHK 
♦SET  RETURN  VALUE  TO  HEX  SUM 
HX ADD  =  HA 
♦E*DROUTINE(HXADU) 

RETURN 

E:<D 


OuO  l 

0002  C 

0003  C 

0004  C 

000b  C 

000b  C 

0007  C 

000b  C 

0009  C 

0010  C 

0011  C 

0012  C 

0013  C 

0014  C 

0015  C 

0016  C 

0017  C 

0018  C 

0019  C 

0020  C 

0021  C 

0022  C 

0023  C 

0024.  C 

0025  C 

0026  C 

0027  C 

0028  C 

0029  C 

0030  C 

0031  C 

0032  C 

0033  C 

0034  C 

0035  C 

0036  C 

0037  C 

0038  C 

0039  C 

0040  C 

0041  C 

0042  C 

0043  C 

0044  C 

0045  C 

>046  C 

>047  C 

>048  C 

>049  C 

>050  C 

7051  C 

0052  C 

7053  C 

0054  C 

>055  C 

0056  C 

0057  C 


S  JB  KOtJ  TINS  HXtRR(NA*SUB,ICASE,  I  PARI ,  IPAR2,IPAR3,IPAR4) 

*  ROUTlNF^ENtRATE  HEX  ERROR  MESSAGE  -  HXERR ) 

*«***««  *  *  ********************  ***********  *****  ********************* 

*  designer/phogrammer : 

*  DOM  KRECKtR  24  SEPTEMBER  1980 

*  PURPOSE: 

*  HXERR  WRITES  AN  ERROR  MESSAGE  DESCRIBING  AN  ERROR  WHICH  HAS 

*  BEEN  DEI  EC  TED  IN  ONE  OF  THE  HEX  LIBRARY  ROUTINES.  IT  ALSO 

*  CALLS  A  USER  DEBUG  ROUTINE,  HXD8UG,  FOR  ADDITIONAL  ERROR 

*  PROCESSING.  A  STUB  VERSION  OF  HXDBUG  IS  INCLUDED  IN  i  HE 

<=  HEX  LIBRARY  IN  CASE  THE  USER  DOES  NOT  PROVIDE  A  VERSION  TO 

*  OVERRIDE  IT. 

*  CALLING  SEQUENCE: 

*  CALL  HXERRfNAMSUB, ICASE, IPARl , TPAR2, IPAR3,  IPAR4) 

*  input: 

*  NAMSU8  -  NAME  OF  THE  HEX  LIBRARY  ROUTINE  IN  WHICH  THE  ERROR 

*  w  AS  DETECTED.  THIS  MAY  BE  A  LOWER  LEVEL  ROUTINE 

*  INSTEAD  OF  A  HEX  ROUTINE  CALLED  DIRECTLY  FROM  OUT- 

*  SIDE  THE  HEX  LIBRARY.  THIS  PARAMETER  IS  PASSED 

*  USING  A  6H  HOLLERITH  CONSTANT. 

*  ICASE  -  CASE  NUMBER  IDENTIFYING  THE  TYPE  OF  ERROR  WHICH 

*  WAS  DETECTED: 

*  l  ZERO  OR  NEGATIVE  HEX  ADDRESS 

*  2  HEX  AODRESS  WITH  HEX  LEVEb  OUT  OF  RANGE 

*  3  hex  level  OUT  OF  RANGE 

*  4  Two  HEX  CENTERS  COINCIDE 

*  b  TWO  HEX  ADDRESSES  AT  DIFFERENT  HEX  LEVELS 

*  b  TWO  HEX  ADDRESSES  COINCIDE 

*  IPARl , IPAR2, IPAR3,  IPAH4 

*  -  PARAMETERS  WHICH  GIVE  ADDITIONAL  INFORMATION  ABOUT 

*  THE  ERROR.  THE  MEANING  OF  THESE  PARAMETERS  IS 

*  DEPENDENT  ON  THE  TYPE  OF  ERROR; 

*  icase=i  i Zero  or  negative  hex  address) 

*  I  PAR  1 sHEX  ADDRESS 

*  IPAR23IPAR3=IPAR4=0 

*  ICASE=2  (HEX  ADDRESS  «I£H  LEVEL  OUT  OF  RANGE) 

*  IP AR l  =HEX  ADDRESS 

*  .  I P AR2  =  L£ VEL  OF  HEX  ADDRESS 

*  I  PAR  3* I P AR4*0 

*  ICASE=3  (HEX  LEVEL  OUT  OF  RANGE) 

*  IPARl s HEX  LEVEL 

*  IPAR2sIPAR3sIPAR4sO 

*  ICASE=4  (HEX  CENTERS  COINCIDE) 

*  IPARlsADDKESS  OF  FIRST  HEX 

*  IPAR2=ADDRESS  OF  SECOND  HEX 

*  IPAR3sIPAR4sO 

*  ICASEss  (HEX  ADDRESSES  AT  DIFFERENT  LEVELS) 

*  IPARl sFIRST  HEX  ADDRESS 

*  IPAR2=LE VEL  OF  FIRST  HEX  ADDRESS 

*  I P AR3=SEC0ND  HEX  ADDRESS 

*  IPAR43LEVEL  OF  SECOND  HEX  ADDRESS 

*  1CASE36  (HEX  ADDRESSES  COINCIDE) 

*  IPARlsCOMMON  HEX  ADDRESS 

*  IPAR2sIPAR3sIPAR4sO 

«  IHXOUT  -  OUTPUT  DEVICE  NUMBER  TO  WHICH  HEX  ERROR  MESSAGES 

*  ARE  TO  BE  WRITTEN.  (IN  COMMON/HCX/) 


005b 
0059 
0060 
0061 
0062 
0063 
0064 
0065 
0066 
•0067 
0068 
0069 
'0070 
0071 
0072 
0073 
0074 
0075 
0076 
0077 
0078 
0079 
0080 
0081  • 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 
0092 
0093 
0094 
0095 
0096 
0097 
0098 
0099 
0100 
0101 
0102 
0101 
0104 
0105 
0106 
0107 
0108 
0109 
0110 
0111 
0112 
0113 
0114 


c  * 

c  ***************************************************************** 

IMPLICIT  IN  T£GER( H,  p) 

C->M  MON/HEX/ 1  HX0UT,NHLEV,  MI  NLEV  , SL TO , CLTO , DLNO , D I A M ( 10)  ,  01  AMT 
SR, 

+  AnFI,YOFI,XOFJ,YUFJ,RIOFX,RJOFX,RIJFY, RJOFY , 

¥  ICON (70) ,JC0N(70) ,  IMAX( 7) , JMAX(7) 

DIMENSION  IVALC7) , JVAL(7) 

I N  TEGER  *2  NAMSUB(3) 

EjUIVALENCE(IVALCI) , ICON ( 1 ) ) , (JVAL(l) ,JCON( 1) ) 

C  *WRITE  ERROR  MESSAGE  HEADING 

*RiTE(IHX0UT,9Q00) 

C  *CASE(TYP£  OF  ERROR) 

GOTO  (1 tOO, 1200,1300, 1430, 1500, 1600)  ICASE 
C  *TYP£  =  ZERO  OR  NEGATIVE  HEX  ADDRESS 

1100  CONTINUE 

C  trtRlTE  MESSAGE  AND  INVALID  HEX  ADDRESS 

<fRITE(IHXOUT,900l)  NAMSUB, IPAR1 
C  *T YPE  s  HEX  ADDRESS  *ITH  LEVEL  OUT  OF  RANGE 

GOTO  1700 

1200  CONTINUE 

C  +WRITE  MESSAGE  AND  INVALID  HEX  AND  LEVEL 

NRITECIHXOUT, 9002)  N AMSUB , I  PAR l , I PAR2 
C  *T YPE  =  HEX  LEVEL  OUT  OF  RANGE 

GOTO  1700 

1300  CONTINUE 

C  *NRITE  MESSAGE  AND  INVALID  HEX  LEVEL 

*RITE(IHX0UT,9003)  NAMSUB,IPAR1 
C  *TYPE  a  HEX  CENTERS  COINCIDE 

GOTO  1700 

1400  CONTINUE 

C  *  NR  I TE  MESSAGE  AND  INVALID  HEX  PAIR 

NRITE(IHX0UT,9U0  4)  NAMSUB, I  PAR  1 , IPAR2 
C  *  TYPE  s  HEX  ADDRESSES  AT  DIFFERENT  LEVELS 

GOTO  1700 

1500  CONTINUE 

C  *NRIT£  MESSAGE  ANO  INVALID  HEXES  AND  LEVELS 

«RlTE(IHXnuT,9005)  N AMSUB , I P AR l , IPAR2 , IP AR 3 , I P AR4 
C  *TYPE  s  HEX  ADDRESSES  COINCIDE 

GOTO  1700 

1600  CONTINUE 

C  *WRITfi  MESSAGE  AND  COMMON  HEX  ADDRESS 

«RITE(IHXOUT,9006)  NAMSUB, IPAR1 
C  *END  CASE(TYPE  OF  ERROR) 

1700  CONTINUE 

C  * I NCLUDE ( USER  HEX  DEBUG  ROUTINE  -  HXDBUG) 

CALL  HXOBUG( NAMSUB, ICASE, IPAR1 , IPAR2, IPAR3 , IPAR4) 

C  *ENOROUTIn£(hXERk) 

RETURN 

9000  FORMA f(54H0*4t4*4*+*+  HXERR  -  ERROR  DETECTED  IN  HEX  ROUTINE: 

♦  15H  ♦♦♦♦♦♦♦*♦♦,/) 

9001  FORMA i (5X, 3A2,47H  HAS  BEEN  PASSED  A  ZERO  OR  NEGATIVE  HEX  ADDRESS 

♦  / , 5X »  5HHEX  3,012) 

9002  FORMA TCSX, 3A2, 47H  HAS  BEEN  PASSED  A  HEX  ADDRESS  WITH  AN  INVALID 

♦  '  1LEVEL,/,5X,5HHEX  *,012,9H  LEVEL  *,13) 

9003  F0RMA1(5X,3A2,37H  HAS  BEEN  PASSED  AN  INVALID  HEX  LEVEL, /,5X, 

t  7HLEVEL  3,18) 
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UNCLASSIFIED 


F/G  15/7 


NL 


HXEkK 


0115 

0116 

0117 

0118 

0119 

0120 

0121 


9004  F )RNAT(5X, 3A2,4;>H  HAS  BEEN  PASSED  HEX  ADDRESSES  WHOSE  CENTERS  , 

♦  8HCDINCIDE,/,  5X,6HHEXA  =,012,8H  HEXB  =,012) 

9005  FJRNAT(5X,3A2,44H  HAS  BEEN  PASSED  HEX  ADDRESSES  AT  DIFFERENT  , 

¥  6HL£V£LS,/,5X,6HHEXA  =,012, 10H  LEVELA  =,I3,8H  HEXB  =, 

¥  012, 1)H  LE  YELB  =,I3) 

9006  FJK4AT(5X,3a2,45H  HAS  BEEN  PASSED  HEX  ADDRESSES  WHICH  COINCIDE,/ 

¥  5X , 1 3HHEXA  =  HEXB  =,012) 


0001 

0002 

0003 

0u04 

0005 

000b 
000/ 
0008 
oooy 
0010 
*0011 
0012 
.001  3 
0014 
0015 
OOlo 
0017 
0018 
0019 
0020 
0021 
0022 
0023 
0024- 
0025 
002b 
002/ 
0028 
0029 
0030 
0031 
0032 
0033 
0034 
0035 
0036 
0037 
0038 
0039 
0040 
0041 
*  0042 
0043 
0044 
0045 
004* 
0047 
0048 
0049 
0050 
0051 
0052 
0053 
0054 
0055 
005b 
0057 


SUBROUTINE  rlXIN  1 T ( I WR I TE , LE V M A X , LE VM I N , DLT , ULN , LE VS I Z , SI ZHEX ) 

Rj'jriNEcniriAtuzfc:  hex  library  parameters  -  hxinid 

***************  ********************************  ****************** 

designer/phogrammer: 

00.4  KRECKSR  25  SEPTEMBER  1980 

purpose: 

HXiMir  initializes  parameters  for  a  GIVEN  configuration 

OF  THE  HEX  LIBRARY.  A  PROGRAM  USING  THE  HEX  LIBRARY  MUST 
CALL  HX1NIT  BEFORE  CALLING  ANY  OTHER  HEX  LIBRARY  ROUTINES. 
THE  INITIALIZATION  REQUIRES  INPUT  PARAMETERS  SPECIFYING 
THE  DEVICE  NUMBER  TO  WHICH  ERROR  MESSAGES  ARE  TO  BE  WRIT¬ 
TEN,  the  MAXIMUM  AND  MINIMUM  HEX  LEVELS,  THE  LATITUDE  AND 
LONGITUDE  OF  THE  ORIGIN  OF  THE  COORDINATE  SYSTEM,  AMD  THE 
DIAMETER  OF  HEXES  AT  SOME  CONVENIENT  LEVEL  OF  AGGREGATION. 
THESE  AND/OR  FUNCTIONS  OF  THESE  PARAMETERS  ARE  SAVED  IN 
THE  COMMON  BLOCK  /HEX/,  WHICH  IS  RESERVED  FOR  HEX  LI¬ 
BRARY  USE. 

CALLING  SEQUENCE: 

CALL  HXINIT(IWR1TE,LEVMAX,LEVMIN,DLT,DLN,LEVSIZ,SIZHEX) 

input: 

ImRITE  -  DEVICE  NUMBER  TO  WHICH  HEX  ERROR  MESSAGES  ARE  TO 
BE  WRITTEN 

LEVMAX  -  MAXIMUM  LEVEL  OF  HEX  AGGREGATION.  THE  MOST  SIG¬ 
NIFICANT  DIGIT  IN  HEX  ADDRESSES  «ILL  REPRESENT 
A  HEX  AT  THIS  LEVEL.  NOTE  THAT  THIS  TOGETHER 
nITH  THE  DIAMETER  OF  HEXES  AS  SPECIFIED  BY  LEVSIZ 
AND  SIZHCX  WILL  BOUND  THE  AREA  COVERED  BY  THE  HEX 
COORDINATE  SYSTEM. 

LEVMIN  -  MINIMUM  LEVEL  OF  HEX  AGGREGATION.  THE  CONFIGURA¬ 
TION  WILL  TREAT  HEXES  AT  THIS  LEVEL  AS  REGULAR 
HEXAGONS.  LARGER  HEXES  AT  HIGHER  LEVELS  WILL  ONLY 
APPROXIMATE  REGULAR  HEXAGONS  IN  SHAPE. 

DLT  -  LATITUDE  OF  THE  ORIGIN  OF  THE  HEX  COORDINATE 

SYSTEM  EXPRESSED  IN  DEGREES  AS  A  FLOATING  POINT 
NUMBER 

DLN  -  LONGITUDE  OF  THE  ORIGIN  OF  THE  HEX  COORDINATE 

SYSTEM  EXPRESSED  IN  DEGREES  AS  A  FLOATING  POINT 
NUMBER 

LEVSIZ  -  HEX  LEVEL  IN  TERMS  OF  *HICH  THE  SCALE  OF  THE  HEX 
COORDINATE  SYSTEM  IS  GIVEN 

SIZHEX  -  DIAMETER  OF  HEXES  AT  LEVEL  LEVSIZ  EXPRESSED  IN 

METERS  AS  A  FLOATING  POINT  NUMBER.  DIAMETERS  OF 
HEXES  AT  OTHER  LEVELS  ARE  COMPLETELY  DETERMINED 
GIVEN  THIS  ONE  DIAMETER. 


OUTPUT: 

ihxout  - 

NHLEV  - 


MINLEV 

SLTO 

CLTO 

OLNO 


OUTPUT  DEVICE  NUMBER  TO  WHICH  HEX  ERROR  MESSAGES 
ARE  TO  BE  WRITTEN.  (IN  COMMON/HEX/) 

MAXIMUM  NUMBER  OF  LEVELS  OF  HEX  AGGREGATION. 

THIS  INCLUDES  LEVMAX  THROUGH  LEVEL  0  EVEN  IF 
LEVMIN  IS  GREATER  THAN  0.  (IN  COMMON/HEX/) 
MINIMUM  HEX  LEVEL.  (IN  COMMON/HEX/) 

SINE  OF  THE  LATITUDE  OF  THE  ORIGIN  OF  THE  HEX 
COORDINATE  SYSTEM.  (IN  COMMON/HEX/J 
COSINE  OF  THE  , A  rt TUD6  OF  THE  ORIGIN  OF  THE  HEX 
COORDINATE  SYSltM.  (IN  COMMON/HEX/) 

LONGITUDE  OF  THE  ORIGIN  OF  THE  HEX  COORDINATE 
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0058 

0059 

0060 

0o61 

0062 

0u6i 

0064 

0065 

0066 

0067 

0068 

0069 

0070 

0071 

0072 

0073 

0074 

0075 

0076 

0077 

0078 

0079 

0080 

0081- 

0082 

0083 

0084 

0085 

0086 

0087 

0088 

0089 

0090 

0091 

0092 

0093 

0094 

0095 

0096 

0097 

0098 

0099 

0100 

0101 

0102 

010.3 

0104 

0105 

0106 

0107 

0108 

0109 

011U 

0111 

0112 

0113 

0114 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

***** 

* 

***** 


***** 


SYSTEM  EXPRESSED  AS  A  REAL-VALUED  QUANTITY  IN 
DEGREES.  (IN  COMMON/HEX/) 

DIAM(MDIG) 

-  ARRAY  CONTAINING  THE  DIAMETER  IN  METERS  OF  A  HEX 
NHJSE  ADDRESS  CONTAINS  NDIG  HEX  DIGITS.  (IN 
COMMON/HEX/) 

DIAmTR  -  DIAMETER  IN  METERS  OF  HEXES  AT  THE  MINIMUM  HEX 
LEVEL.  (IN  COMMON/HEX/) 

XOFI  -  X  COORDINATE  OF  THE  VECTOR  (I,J)  s  (1,0)  AT  THE 


MINIMUM  HEX  LEVEL. 
YOFI  -  Y  COORDINATE  OF  THE 
MINIMUM  HEX  LEVEL. 
XOFJ  -  X  COORDINATE  OF  THE 
MINIMUM  HEX  LEVEL. 
Y3FJ  -  Y  COORDINATE  OF  THE 
MINIMUM  HEX  LEVEL. 
RIQFX  -  REAL  I  COORDINATE  AT 

(X, Y)  =  (1,0) 
COORDINATE  AT 
(X, Y)  =  (1,0) 
COORDINATE  AT 
<  X , Y )  =  (0,1) 
COORDINATE  AT 
(X, Y)  s  (U,l) 
(W0X-1)*7) 
(NDX-1)*7) 


VECTOR 
RJOFX  -  REAL  J 
VECTOR 
RIOFY  -  REAL  I 
VECTOR 
RJOFY  -  REAL  J 
VECTOR 
I CON ( HDIG  ♦ 

JCOM ( HOI G  ♦ 


(IN  COMMOM/HEX/) 

VECTOR  (I,J)  s  (1,0)  AT  THE 
(IN  COMMON/HEX/) 

VECTOR  (I,.J)  =  (0,1)  AT  THE 
(IN  COMMON/HEX/) 

VECTOR  (I,J)  s  (0,1)  AT  THE 
(IN  COMMON/HEX/) 

THE  MINIMUM  HEX  LEVEL  OF  THE 
(IN  COMMON/HEX/) 

THE  MINIMUM  HEX  LEVEL  OF  THE 
(IN  COMMON/riEX/) 

THE  MINIMUM  HEX  LEVEL  OF  THE 
(IN  COMMON/HEX/) 

THE  MINIMUM  HEX  LEVEL  OF  THE 
(IN  COMMON/HEX/) 


-  ARRAYS  CONTAINING  THE  I  AND  J  CONTRIBUTIONS  OF 
EACH  POSSIBLE  HEX  DIGIT  (1-7)  AT  EACH  POSSIBLE 
DIGIT  POSITION  IN  A  HEX  ADDRESS.  HDIG  INDICATES 
THE  HEX  DIGIT,  AND  NOX  INDICATES  ITS  POSITION 
COUNTING  FROM  THE  RIGHT.  (IN  COMMON/HEX/) 

IVAL(HDIG) 

JVAL(HDIG) 

-  ARRAYS  CONTAINING  THE  I  AND  J  COORDINATES  CORRE¬ 
SPONDING  TO  EACH  OF  THE  7  SINGLE  DIGIT  HEX  VEC¬ 
TORS  (1-7).  (IN  COMMON/HEX/) 

IMAX(HDIG) 

JMAX(HDIG) 

-  ARRAYS  CONTAINING  THE  I  AND  J  COORDINATES  (AT  THE 
MINIMUM  HEX  LEVEL)  OF  THE  CENTERS  OF  EACH  OF  THE 
7  HEXES  OF  MAXIMUM  LEVEL.  (IN  COMMON/HEX/) 

**** *******************************  ************************ t***** 
INCLUDE  'HEX.CMN' 

* *********************************************************  ****** 
FOR  DEFINITIONS  OF  VARIABLES  SEE  HXINIT.FOR  * 

**************  *******  **********************  ******  ******  ********* 
IMPLICIT  INTEGER ( H , P) 

common/hex/ihxout,nhlev,minlev,slto,clto,dlno,diamcio) ,OIAMTR, 

XOFI,YOFI,XOFJ,YOFJ,RIOFX, RJOFX, RIOFY, RJOFY, 

ICON ( 70 ) , JCON (70),IMAX(7),JMAX(7) 

**************************************************************** 
DIMENSION  I VAL( 7 ) , J VAL( 7 ) 

EQUI VALENCE! I VAL(1),IC0N(1)),(JVAL(1), JCON (1)) 

HEX  ROTATIONAL  CONSTANT  IN  DEGREES  -  ARCTAN (S JRT( 3 ) /5 ) 

DATA  RCON/19. 10661/ 

DEGREES  TO  RADIANS  CONVERSION  CONSTANT 
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C 


hi  x  1 4 1  r 


Oils 

Olio 

0117 

Olid 

0119 

>120 

0121 

0122 

0123 

0124 

0125 

0120 

0127 

0128 

0129 

0130 

0131 

0132 

0133 

0134 

0135 

0136 

0137 

0138- 

0139 

0140 

0141 

0142 

0143 

0144 

0145 

0146 

0147 

0148 

0149 

0150 

0151 

0152 

0153 

0154 

.0155 

3156 

0157 

0158 

3159 

0160 

3161 

0162 

0163 

0164 

t>165 

0166 

0167 

0168 

0169 

0170 

0171 


C 

c 

c 

c 

c 

c 

c 

c 

c 

1100 

c 

c 

c 

c 

c 

c 

c 

c 

c 

1200 

c 


DATA  UG2RD/0.U1  Z45329/ 

♦  set  OUTPUT  DEVICE  NUMBER  FOR  HEX  ERROR  MESSAGES 
IHXOUT  S  I *R1 T£ 

♦SET  MAXIMUM  NUMBER  OF  LEVELS  TO  MAXIMUM  LEVEL  PLUS  ONE 
NHLEV  s  LEVMAX  4-  1 

♦SET  MINIMUM  LEVEL 
MINLEV  3  LEVMIN 

♦COMPUTE  SINE  AND  COSINE  UF  LATITUDE  OF  ORIGIN 
RLf  s  OLT  *  DG2RD 
SLTO  s  SlN(RbT) 

CLIO  s  CJS(RLT) 

♦SET  LONGITUDE  OF  ORIGIN 
ULnO  s  DUN 

♦DETERMINE  NUMBER  OF  DIGITS  IN  MINIMUM  LEVEL  HEX  ADDRESS 
4013  *  NrtLEV  -  MINuEV 

♦COMPUTE  DIAMETER  Of  HEX  AT  MINIMUM  LEVEL 
SQRT7  s  SuRTU.O) 

DIAMTR  3  SIZHEX/(S3RT7**(LEVSIZ-MINLEV)) 

♦INITIALIZE  DIAMETER  COMPUTATION  LOOP  AT  MINIMUM  HEX  LEVEL 
NHD  s  MDIG 
SIZ  s  DIAMTR 

♦LOOP( F JR  ALL  HEX  LEVELS) 

COnTINJE 

♦SET  DIAMETEK  OF  HEX  AT  THIS  LEVEL 
DIAM(NHO)  s  SIZ 

♦UPDATE  NUMBER  OF  OIGITS  AND  DIAMETER  FOR  NEXT  LEVEL 
NHO  s  NrlD  -  1 
SIZ  a  SIZ  ♦  S0RT7 

♦ENDLUOP ( HEX  UEVEL  LOOP) 

IF(NHD.GT.O)  GOTO  1100 

♦COMPUTE  POLAR  COORDINATE  ANGLES  OF  I-  AND  J-AXES  AT  MiN  LEVEL 
R0T8  s  RCON  ♦  FLOAT! MINLEV ) 

ANGLEI  3  (>90.0  ♦  R0T8)  ♦  DG2RD 
ANGLEJ  s  (-30. 0  ♦  R0T8 )  ♦  UG2RU 

♦  COMPUTE  X  ,  Y  COORDINATES  OF  UNIT  I  AND  J  VECTORS  AT  MIN  LEVEL 
XOFI  s  COS ( ANGLEI )  *  DIAMTR 

KOFI  s  SIN(ANGLEI)  *  DIAMTR 
XOFJ  3  CJS(ANGLEJ)  ♦  DIAMTR 
KOFU  s  SIN(ANGLEJ)  ♦  OIAMTR 

♦COMPUTE  I ,  J  COORDINATES  AT  MIN  LEVEL  OF  UNIT  X  AND  Y  VECTORS 
DTERM  s  XOFI ♦YOFJ  -  XOFJ^YOFI 
RIJFX  s  > YOFJ/DTERM 
RJOFX  s  -Y OF I /DTERM 
RIOFY  s  -XJFJ/DTERM 
RJOFY  s  +XQF l/OTERM 

♦LOOP(FOR  ALL  SINGLE  DIGIT  HEX  VECTORS) 

DO  1200  HDIG  a  1,7 

♦SET  CORRESPONDING  I  AND  J  COORDINATES 
IPART  s  I  AND ( HDIG , 1 ) 

,  JPART  3  IAND(ISHFT(HDIG,-l),t) 

APART  s  ISHFT(H0lG,-2) 

I VAL( HDIG)  s  IPART  -  APART 
JVAL(HDIG)  s  JPART  -  APART 

♦ENDLOQP( SINGLE  OIGIT  HEX  VECTOR  LOOP) 

CONTINUE 

♦INITIALIZE  I  AND  J  CONTRIBUTION  COMPUTATION  LOOP  INDICES 


IXOLO  s  0 
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A  *  ^  *  .  %  ^ 

HXINIT 

0172 

IXNEM  =  7 

017  J 

1XLI M  s  7*8DIG 

0174 

C 

♦LOOP (FOR  ALL  POSSIBLE  DIGIT  POSITIONS  PAST 

FIRST) 

017b 

1300 

CONTINUE 

0176 

c 

♦  LOOP C FOR  ALL  HEX  DIGITS) 

0177 

DJ  1400  HDIG  a  1,7 

0170 

c 

♦COMPUTE  I  AND  J  CONTRIBUTIONS  FROM  LAST  POSITION  VALUES 

0179 

IC3N(HDIG+IXNEN)  a  2*IC0n(hDIG*IX0L0) 

♦  JC3N(HDI3+iX0LD) 

0180 

JCON(HDIG>IXNEn)  s  3*JCUN  (  HD1G+-IXOLO) 

-  1CONCHUIG+IXOLD) 

0181 

c 

♦ENDLOOPCHEX  DIGIT  LOOP) 

0182 

1400 

CONTINUE 

018  J 

C 

♦UPDATE  LOOP  INDICES  FOR  NEXT  DIGIT  POSITION 

0184 

IXOLD  a  IXNE8 

0185 

IXNEW  a  IXOLD  ♦  7 

0186 

C 

♦ENDLOOP( DIGIT  POSITION  LOOP) 

0187 

IFdXNCN.LT. IXLIN)  GOTO  1300 

0188 

C 

♦LOOPCFJR  ALL  HEXES  OF  MAXIMUM  LEVEL) 

0189' 

00  1500  HDIG  a  1,7 

0190 

c 

♦SET  I  AND  J  COORDINATES  AT  MINIMUM  HEX  LEVEL 

0191 

IMAX(HDIG)  a  ICON ( HOI G+ IXOLD) 

0192 

JMAX(HDIG)  a  JCON ( HDIG+IXOLD) 

019  J 

c 

♦ENOLOOPC HEXES  of  maximum  LEVEL  LOOP) 

0194 

1500 

CONTINUE 

0195 

C 

♦ENOROUTINE(HXINIT) 

0196 

RETURN 

0001  INTEGER  FUNCTION  HXINV(HEX) 

0002  C  'ROUTINEIFINO  h£X  INVERSE  OF  AN  UCTAL  HEX  NUMBER  -  HXINV) 

0003  C  ****************************************************************** 

0004  C  * 

000b  C  *  DESIGN  SR /PROGRAMMER? 

0006  C  *  DON  KRECKER  12  SEPTEMBER  1980 

0007  C  *  purpose: 

OOOtt  C  *  HXINV  COMPUTES  THE  INVERSE  OF  A  HEX  NUMBER  EXPRESSED  IN 

0009  C  *  OCTAL  REPRESENTATION.  THE  ALGORITHM  INVERTS  ALL  HEX  DIGITS 

0010  C  *  IN  PARALLEL.  HEX  DIGITS  1  THROUGH  6  ARE  COMPLEMENTED  MOD 

0011  C  *  7 ,  wHILE  i HE  HEX  DIGIT  7  REMAINS  UNCHANGED.  OCTAL  0  DIGITS 

0012  C  *  TO  THE  LEFT  OF  THE  MOST  SIGNIFICANT  HEX  DIGIT  ALSO  REMAIN 

ooij  c  *  Unchanged,  the  algorithm  uses  shift  and  logical  operations 

0014  C  *  TO  FLAG  THE  DIGITS  l  THROUGH  6.  THEN  THESE  DIGITS  ARfc  IN- 

0015  C  *  VERTED  WHILE  THE  0  AND  7  DIGITS  ARE  UNTOUCHED. 

001b  C  *  CALLING  SEQUENCE: 

0017  C  *  H  X I  •<  V  s  HXINV(HEX) 

0018  C  *  INPUT: 

0019  C  *  HEX  -  HEX  NUMBER  TO  BE  INVERTED 

0020  C  '  OUTPUT: 

0021  C  *  H X I M V  -  HEX  INVERSE  OF  THE  ARGUMENT  HEX  NUMBER 

0022  C  * 

0023  C  M*****»»»**»»*M*»**#***»I***»*»*I»«M*M*«*»»**IM*»»***»*«*»»** 

0024-  I  MPLICIT  I N  TEGER ( H , P ) 

0025  C  'MASK  OF  OCTAL  1  DIGITS 

0026  DATA  M I / # l 1 1 l 1 1 1 1 1 i '0/ 

0027  C  'SET  LOCAL  VARIABLES  TO  HEX  NUMBER  SHIFTED  0,  1,  AND  2  BITS 

0028  HSHFTO  =  HEX 

0029  HSHFT1  s  ISHFTC HEX , - l ) 

0030  HSHFT2  *  ISHFT ( HEX , -2 ) 

0031  C  'FLAG  DIGITS  1  THROUGH  6  IN  LUw  ORDER  BIT  POSITION  OF  DIGITS 

0032  MIT06  s  I AwD ( IOR ( I EOR ( HSHFTO , HSHFT1 ) , IEOR ( HSHFT1 , HSHFT2 ) ) , M 1 ) 

0033  C  'EXTEND  FLAGS  TU  MASK  ALL  3  BITS  OF  DIGITS  1  THROUGH  6 

0034  M 1 f 06  s  MlTOb  *  7 

0035  C  'INVERT  DIGITS  1  THROUGH  6  AND  RETURN  RESULT  AS  HEX  INVERSE 

0036  HXINV  s  I£UR(HEX,M1T06) 

0037  C  'ENOROUTINE(HXINV) 

0038  RETURN 

0039  END 


0001  SJHKOUTINE  IGRID(X,¥,I,U) 

0002  ************************************************************** 

0003  *  THIS  ROUTINE  CONVERTS  THE  UTN  COORDINATES  X,Y  TO  THE 

0004  *  GRID  INDICES  I,J. 

0005  *  THE  ORIGIN  IS  500,000  5,600,000  I*  GRID  ZONE  320  AND 

0006  *  THE  UNITS  ARE  20  4ETERS.  THE  INDEX  FOR  THE  ORIGIN  IS 

000 1  *  IN  RECORD  (b5,65)  OUT  Of  128*120  RECORDS. 

0008  ************************************************************** 

0009  implicit  integer*4  ca-Z) 

0010  IS((X-500000)/20+32500)/500 

0011  J3( ( ¥-5600000) /20*32500)/500 

0012  RETURN 

0013  ENO 
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oooi  function  icooc ( i ,  j  ) 

0002  M***Mf*M*M*M*MIM#*l*MM»l*MM#*MMt»MM*«*M*** 

OOOi  *  EXTRACTS  THE  FEATURE  CODE  FROM  IBUF(I,J)  * 

0004  ********************************************************** 

0005  *  INPUTS:  I,J;  THE  V  AND  X  INDICES, RESPECTIVELY  * 

0006  *  OUTPUTS:  ICODE,  THE  SURFACE  FEATURE  CODE  * 

0007  ********************************************************** 

0000  IMPLICIT  IN  TEGER*2  (I-N) 

0009  INCLUDE  'MAP, CRN  9 

0010  1  *********************************************************** 
0011  1  *  IBUF  HOLDS  A  40*40M  ARRAY  OF  DISPLAY  DATA ,  N I TH  * 

0012  1  *  THE  FIRST  INDEX  CORRESPONDS  TO  NORTHING,  AND  * 

0013  1  ♦  THE  SECOND  TO  EASTING.  * 

0014  1  *********************************************************** 

0015  1  INTEGERS  IBUF(400, 400) 

0016  1  COMMON  /MAP/IBUF 

0017  1  *********************************************************** 

0018  IC00E=IBUF(I,J)-IELV(I,J)*8 

0019  C  D  CALL  CMCLOS 

0020  C  0  PRINT*, ICODE, IELV(I,J) 

0021  C  D  CALL  CMOPEN 

0022  RETURN 

0023  END 
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0001  FUNCTION  IELV(I,J) 

0002  ***********  ******  ************************************  ******* 

0003  *  EXTRACTS  THE  ELEVATION  FROM  IBUF(I,J)  * 

0004  ************************************************************ 

0005  *  INPUTS:  I,J;  THE  Y  AND  X  COORDINATES, RESPECTIVELY  * 

0006  *  OUTPUTS:  IELV ,  THE  ELEVATION  OF  THE  POINT  * 

0007  ************************************************************ 

0008  IMPLICIT  IN  TEGER*2  (I-N) 

0009  INCLUDE  'NAP. CNN' 

0010  1  *********************************************************** 
0011  1  *  I  dUF  HOLDS  A  40M0KN  ARRAY  OF  DISPLAY  DATA, Nl TH  * 

0012  1  •  THE  FIRST  INDEX  CORRESPONDS  TO  NORTHING,  AND  * 

OOli  1  ♦  THE  SECOND  TO  EASTING.  * 

0014  1  *********************************************************** 

0015  1  INTEGERS  I  dUF  (  400 , 400  ) 

0016  1  COMNON  /M AP/IBUF 

0017  1  *********************************************************** 

0018  C  D  PRINT*, #IELV',I,J 

0019  IELV=iaUF(I, J)/8 

0020  RETURN 


Sf‘  . . 1 

f 

ft 

3 

r  ^ 

-\ 

v  0U01 

INTEGER  FUNCTION  I  JL2rl  A  (  I,J,LEVIJ) 

i  00«2 

c 

•KJUTIwElCONVEkT  I,J,  A  NO  LEVEL  TO  EQUIVALENT  HEX  AODRESS-1 JL2MA) 

1  OOOi 

c 

Of*************************************************************** 

>  0004 

c 

* 

i-.  000b 

c 

* 

designer/programmer: 

0006 

c 

* 

DUN  KRECKER  18  SEPTEMBER  1980 

0007 

c 

« 

purpose: 

£  0000 

c 

* 

IJL2HA  CONVERTS  A  GIVEN  I,J,  AND  LEVEL  TRIPLE  TO  AN  EJUI-  j 

■  0009 

c 

* 

VALENT  HEX  ADDRESS  IN  OCTAL  REPRESENTATION .  1  ANO  J  ARE 

!>;  .0010 

c 

* 

OBLIQUE  COORDINATES  EXPRESSED  In  UNITS  CORRESPONDING  TO 

%  0011 

c 

* 

HEX  DIAMETERS  AT  THE  GIVEN  LEVEL  OF  HEX  AGGREGATION,  AND 

■$  0012 

c 

* 

THE  COMPUTED  HEX  ADDRESS  *IbL  3E  AT  THIS  SAME  LEVEL. 

*5  0013 

c 

« 

IJL2HA  IS  THE  INVERSE  OF  THfc.  SUBROUTINE  H A2 I JL  *HICH  COM- 

£  0014 

c 

* 

PUTtS  THE  I,J,  AND  LEVEL  TRIPLE  CORRESPOND! MG  TO  A  GIVEN 

1  0U15 

c 

* 

HEX  ADDRESS. 

0016 

c 

* 

AFTER  CHECKING  THE  VALIDITY  OF  THE  REQUESTED  HEX  LEVEL, 

>;  0017 

c 

* 

THE  ALGORITHM  CONSTRUCTS  THE  HEX  ADDRESS  AT  THAT  LEVEL 

ooi8 

c 

* 

CENTERED  AT  THE  ORIGIN.  THIS  IS  A  STRING  OF  (NHLEV-LEVKL)  ; 

0019 

c 

* 

HEX  DIGITS,  EACH  EQUAL  TO  7,  WHERE  NHLEV  IS  THE  MAXIMUM 

±  0020 

c 

* 

NUMBER  OF  LEVELS  OF  HEX  AGGREGATION.  THEN,  WORKING  FROM 

I  0021 

c 

* 

RIGHT  TO  LEFT,  SUCCESSIVE  HEX  DIGITS  ARE  EXTRACTED  FROM 

0022 

c 

* 

THE  I,J  COORDINATES  AND  INSERTED  IN  PLACE  OF  7S  IN  THE 

£  0023 

c 

* 

HEX  ADDRESS.  THE  HEX  DIGITS  ARE  COMPUTED  AS  DESCRIBED  IN 

•-}  0024 

c 

* 

THE  ROUTINE  IJ2HV. 

0025 

c 

* 

CALLING  SEQUENCE:  i 

jjj  0026 

c 

* 

IJL2HA  s  IJL2HA(I , J,LEVI J) 

■  0027 

c 

* 

input: 

"  0028 

c 

« 

I,J  -  INTEGER-VALUED  OBLIQUE  COORDINATES  WHICH  ARE  TO 

0029 

c 

* 

oE  CONVERTED  TO  AN  EQUIVALENT  HEX  ADDRESS  AT  THE  J 

**;  0030 

c 

* 

SPECIFIED  LEVEL  OF  HEX  AGGREGATION 

00  31 

c 

* 

LEV I J  -  LEVEL  OF  HEX  AGGREGATION  WITH  RESPECT  TO  WHICH 

THE  I,J  COORDINATES  ARE  EXPRESSED  ANO  AT  WHICH  < 

£  0032 

c 

« 

1  0033 

c 

* 

THE  HEX  ADDRESS  IS  TO  dE  COMPUTED 

0034 

c 

* 

NHLEV  -  MAXIMUM  NUMBER  OF  LEVELS  OF  HEX  AGGREGATION. 

£  0035 

c 

* 

(IN  COMMON/HEX/) 

^  0036 

c 

* 

MINLEV  -  MINIMUM  HEX  LEVEL.  (IN  COMMON/HEX/) 

V  0037 

c 

« 

I VAL ( HDIG) 

U  0038 

c 

* 

JVAL(HDIG) 

H  0039 

c 

« 

-  ARRAYS  CONTAINING  THE  i,J  COORDINATES  CORRESPON- 

K  0040 

c 

* 

DING  TO  EACH  OF  THE  7  SINGLE  DIGIT  HEX  VECTORS 

^2  0041 

c 

* 

(1-7).  FOR  EXAMPLE,  SINCE  THE  HEX  VECTOR  1  COR- 

3  0042 

c 

* 

RESPONDS  TO  CI,J)  =  (1,0),  IVAL(l)  =  1  AND 

J*3  0043 

c 

* 

JVAL(l)  s  0.  (IN  COMMON/HEX/) 

^  • 0044 

c 

* 

JUTPUT: 

0  0045 

c 

* 

IJL2H4  -  HEX  ADDRESS  CORRESPONDING  TO  THE  GIVEN  I,J  OBLIQUE 

0046 

c 

« 

COORDINATES  AT  THE  SPECIFIED  LEVEL  OF  AGGREGATION 

0047 

c 

* 

0048 

c 

****** **«******« ****************************** ********** **********  1 

;%  0049 

INCLUDE  'HEX.CMM' 

£*  0050 

1  ****** 

***t***************-V*******4  ************************************ 

2  0051 

1  * 

FOR  DEFINITIONS  C*  WAR!'  ^£S  SEE  HXINIT.FOR  ♦  ! 

?!  0052 

1  ****** 

**********************  **, <«f *********************************** 

V  0053 

1 

IMPLICIT  INTEGERS, P) 

0054 

1 

CJMMON/rt£X/IHXOUT,NHLEV,MINL£V,SLTO,CLTO,DLNO,DIAM(10)  ,01  AMIR,  3 

>$•  0055 

1 

♦ 

XOFI , YOFI , XQFJ, YUFJ , K IOFX , RJUFX , HI OFY , RJOFY ,  j 

$  0056 

1 

* 

ICON ( 70 ) , JCON (70),IMAX(7),JMAX(7)  1 

jj  0057 

1  *************** ********************************************** *********  4 

r% 
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0u5« 

0059 

0060 

0061 

0062 

0063 

0064 

0065 

0066 

0067 

0060 

0069 

0070 

0071 

0072 

0073 

0074 

0075 

0076 

0077 

0078 

0079 

0080 

0081. 

0082 

0083 

0084 

0085 

008b 

0087 

0088 

0089 

0090 

0091 

0092 

0093 

0094 

0095 

0096 

0097 

0098 

0099 

0100 


DIMENSION  IVAl( /)  ,  JVAL(7) 

EJIJ1  VAL£NCE(IVAu(l),  ICOM(i))  ,  (JVAL(1),JC0N(1)  J 
C  *IF(VaLIO  HEX  LEVEL) THEM 

IF(LEVIJ.Lr.MlNLEV)  GOTO  1200 
IF(LEVI J.GE.NHLEV)  GOTO  1200 

C  ♦CONSTRUCT  HEX  ADDRESS  AT  GIVEN  LEVEL  CENTERED  AT  ORIGIN 

HAD*  a  1SHFT(1,3*(NHL£V-LEVIJ))  -  1 
C  ♦INITIALIZE  HEX  DIGIT  EXTRACTION  LOOP 

I  LOCAL  =  I 
JLOCAL  =  J 
HSHIFT  a  0 

C  ♦LOOP  UNTIL ( NO  MORE  HEX  DIGITS  TO  EXTRACT  FROM  (I,J)) 

1100  CONTINUE 

C  ♦COMPUTE  NEXT  HEX  DIGIT  a  (I  ♦  2^0)  MOD  7 

HDIG  a  ILOCAL  +  JLOCAL  ♦  JLOCAL 
HDIG  a  HuIG  -  (HDIG/7 ) *7 
IF(HOIG.LE.O)  HDIG  a  HDIG  ♦  7 
C  ♦INSERT  HEX  DIGIT  AT  FRONT  OF  HEX  ADDRESS 

HAOR  =  HADR  -  ISHFT ( 7-HDIG, HSHIFT ) 

HSHIFT  a  HSHIFT  ♦  3 

C  ♦SUBTRACT  (I,J)  CORRESPONDING  TO  NEWLY  FOUND  HEX  DIGIT 

IN£W  =  ILOCAL  -  IVAL(HDIG) 

JNEW  a  JLOCAL  -  J V AL(HDIG) 

C  ♦SHRINK  NEW  1,0  VECTOR  TO  NEXT  LOnER  HEX  LEVEL 

ILOCAL  a  ( 3 * I N £W  -  JnE*)/7 
JLOCAL  a  (INEM  ♦  ONE*  ♦  JNEWJ/7 
C  ♦E.NDlO JP( HEX  DIGIT  EXTRACTION  LOOP) 

Ir (ILOCAL. NE.O)  GOTO  1100 
IF( JLOCAL. NE.O)  GOTO  1100 
C  ♦RETURN  COMPUTED  HEX  ADDRESS 

IJL2HA  a  HADR 

C  ♦ELSEdNVALIO  HEX  LEVEL) 

GOTO  1300 
1200  CONTINUE 

C  ♦SET  RETURN  HEX  ADDRESS  TO  ZERO 

I0L2HA  a  0 

C  ♦INCLUDE (GENERATE  HEX  ERROR  MESSAGE  -  HXERR ) 

CALL  HXERH(6HiJL2HA,3,LEVIJ,0,0,0) 

C  ♦£NDlF( HEX  LEVEL  CHECK) 

1300  CONTINUE 

C  ♦EnDRQUT1N£(1JL2HA) 
return 
Eno 
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005a  C  ♦SET  RETURN  HEX  ADDRESS  TO  ZERO 

0059  IJ*2HA  =  0 

0060  C  *InCU!JOE(S£NEFATE  HEX  ERROR  MESSAGE  -  rlXERR) 

0061  CALL  HXERR(6HlJM2rtA,3,LEV,0,0,0) 

0062  C  *ENOIF(HEX  bE VEL  CHECK) 

006i  1200  CONTINUE 

0064  C  ♦ENDRJUTIN£( 1JM2HA) 

0065  RETURN 

0066  END 
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nrSGrjH  Function  iJM2rtA(I,J,LEV) 

*  RDU  TI NE (CON VERT  MIN  LEVEL  I,J  COORDINATES  TU  HEX  ADDRESS-I JM2HA) 

**********«***************************f***********f*9************* 

*  DESIGNER/PKOGRAM.MER: 

*  DON  KrtECKER  20  SEP  f EMBER  1980 

*  PURPOSE: 

*  IJM2HA  TAKES  A  POINT  EXPRESSED  IN  I,J  OBLIQJE  COORDINATES 

*  AT  THE  MINIMUM  HEX  LEVEL  AND  COMPUTES  THE  ADDRESS  OF  THE 

*  HEX  AT  THE  SPECIFIED  LEVEL  WHICH  CONTAINS  THE  POINT.  THE 

*  HEX  ADDRESS  IS  COMPUTED  In  OCTAL  REPRESENTATION.  IF  THE 

*  SPECIFIED  HEX  LEVEL  IS  GREATER  i H AN  THE  MINIMUM  HEX  LEVEL , 

*  THE  CJMPUTEO  HEX  MAI  DIFFER  FROM  THE  HEX  (AT  THIS  LEVEL) 

*  WHOSE  CENTER  IS  CLOSEST  TO  THE  GIVEN  POINT.  THE  REASON  IS 

*  THAT  HEXES  AT  HIGHER  LEVELS  OF  AGGREGATION  ARE  NOT  TRUE 

*  REGULAR  HEXAGONS  BUT  ONLY  APPROXIMATE  REGULAR  HEXAGONS  IN 

*  SHAPE.  IJM2HA  IS  THE  INVERSE  OF  THE  SUBROUTINE  HA2IJM, 

*  WHICH  CONVERTS  A  HEX  ADDRESS  TO  I,J  COORDINATES  AT  THE 

*  MINIMUM  HEX  LEVEL. 

*  AFTER  CHECKING  THE  VALIDITY  OF  THE  REQUESTED  HEX  LEVEL, 

*  IJM2HA  USES  IJL2HA  TO  COMPUTE  THE  MINIMUM  LEVEL  HEX  ADDRESS 

*  WITH  THE  GIVEN  I,J  COORDINATES.  THEN  THE  ADDRESS  OF  THE 

*  HEX  AT  THE  SPECIFIED  LEVEL  IS  FOUND  B i  TRUNCATING  THE  AP- 

*  PROPRIATE  NUMBER  OF  HEX  DIGITS. 

*  CALLING  SEQUENCE: 

*  IJM2HA  a  IJM2HA(I,J,LEV) 

*  input: 

*  I,J  -  INTEGER-VALUED  OBLIQUE  COORDINATES  AT  THE  MINIMUM 

*  HEX  LEVEL  OF  A  POINT  WHOSE  CONTAINING  HEX  AT  A 

*  SPECIFIED  LEVEL  IS  TO  BE  COMPUTED 

*  LEV  -  LEVEL  JF  AGGREGATION  OF  THE  HEX  ADDRESS  TO  BE 

*  COMPUTED 

*  NHLEV  -  MAXIMUM  NUMBER  OF  LEVELS  OF  HEX  AGGREGATION. 

*  IIN  COMMON/HEX/) 

*  MINLEV  -  MINIMUM  HEX  LEVEL.  (IN  COMMQN/HEX/) 

*  OUTPUT: 

*  IJM2HA  -  ADDRESS  OF  THE  HEX  AT  THE  REQUESTED  LEVEL  WHICH 

*  CONTAINS  THE  GIVEN  I,J  POINT 

******** ****************** **************** ************** ********** 
IMPLICIT  INTEGER(H,P) 

COMMON/HEX/ IHXQUT, NHLEV, M INLEV , SLTO , CLTO , OLNO , DI AM( 10) , DIAMT 
$  R  , 

*  XOFI,YOFI,XOFJ,YOFJ,RIOFX,RJOFX,RIOFY,RJOFY, 

*  1CONC70) , JC0N(70) ,IMAX(7) ,JMAX(7) 

DIMENSION  IVAL(7),0VAL(7) 

EQUIVALENCE!  IVALC1  ),ICON(  1)  )  ,(JVAL(1),JC0N(D) 

•IF(VALID  HEX  LEV£L)THEN 
1FCLEV.lt. MInLEV)  GOTO  1100 
IF(LEV.G£. NHLEV)  GOTO  1100 

•CONVERT  I,J  COORDINATES  TU  MINIMUM  LEVEL  HEX  ADDRESS 
HADR  s  IJL2HA( I, J, MINLEV) 

♦TRUNCATE  HEX  DIGITS  TO  GET  HEX  ADDRESS  AT  REQUIRED  LEVEL 
IJM2HA  *  ISHFT(HAUR, 34(MlNLfcV-LEV) ) 

♦ELSE( INVALID  HEX  LEVEL) 

GOTO  1200 


1100  CONTINUE 
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SUBROUTINE  IJn2aY(I,J,X, Y ) 

♦R3UTINE(C3NVEKT  MIN  LEVEL  I.J  TO  X.Y  COORDINATES  -  IJM2XY) 

♦  ♦ «*«*****« * < *** ***♦ * ************************* *♦** ****** ********** 

*  DESIGNER/ PROGRAMMER! 

*  DON  KRECKER  20  SEPTEMBER  1980 

*  PURPjSE! 

*  IJN2XY  CONVERTS  A  PAIR  OF  I.J  OBLIQUE  COORDINATES  AT  THE 

*  MINIMUM  HEX  LEVEL  TO  THE  EQUIVALENT  X.Y  CARTESIAN  CJOKDI- 

*  NATES  IN  METERS.  THIS  ROUTINE  IS  THE  INVERSE  OF  THE  SUB- 

*  ROUTINE  XY2IJM. 

*  TrtE  CONVERSION  IS  EFFECTED  BY  APPLYING  A  LINEAR  TRAMSFOR- 

*  MAT10N  (IN  THE  FORM  OF  A  MATRIX  MULTIPLICATION)  TO  THE 

*  I.J  VECTOR  TO  OBTAIN  AN  X.Y  VECTOR. 

*  CALLING  SEQUENCE: 

*  CALL  IJM2XY(I,J,X,Y) 

*  input: 

*  I.J  -  INTEGER-VALUED  OBLIQUE  COORDINATES  EXPRESSED  IN 

*  HEX  DIAMETERS  AT  THE  MINIMUM  HEX  LEVEL  NHICH  ARE 

*  TO  BE  CONVERTED  TO  CARTESIAN  COORDINATES 

*  XOFl  -  X  COORDINATE  OF  THE  VECTOR  (I,J)  a  (1.0). 

*  (IN  COMMON/HEX/) 

*  Y3FI  -  Y  COORDINATE  OF  THE  VECTOR  (I.J)  a  (1.0). 

*  (IN  COMMON/HEX/) 

*  XOFJ  -  X  COORDINATE  OF  THE  VECTOR  (I.J)  a  (0.1), 

*  (IN  COMMON/HEX/) 

*  Y OF J  -  if  COORDINATE  OF  THE  VECTOR  (I.J)  a  (0,1). 

*  (IN  common/hex/) 

*  OUTPUT: 

*  X , Y  -  REAL-VALUED  CARTESIAN  COORDINATES  EXPRESSED  IN 

*  METERS  EQUIVALENT  TO  THE  GIVEN  OBLIQUE  COORDINATES 

**«*««««««**«***«*******«*«**«*«*****«***«*****♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦ 
IMPLICIT  INTEGER ( H , P) 

COMMON /HEX/ IHXOUT,NHL£V,MINL£V,SLTO,CLTO,DLNO,DI AM ( 10) .DIAMI 
SR, 

*  XOFI.YOFI.XOFJ.YOFJ.RIOFX.RJOFX.RIOFt.RJOFY, 

*  ICON(70), JCON (70),INAX(7),JMAX(7) 

DIMENSION  I VAL( 7 ) , J  V  AL( 7 ) 

£ JU 1 V ALENCE( I V AL( 1 ) , ICON ( 1 ) ) , ( J VAL( 1 ) , JCON ( i ) ) 

♦CONVERT  INTEGER-VALUED  I.J  COORDINATES  TO  REAL 
RI  a  FLOAT(I) 

RJ  a  FLOAT(J) 

♦TRANSFORM  TO  EQUIVALENT  X.Y  COORDINATES  IN  METERS 
X  a  XOFI  ♦  RI  ♦  XOFJ  *  RJ 
i  a  YOFI  ♦  RI  ♦  YOFJ  ♦  RJ 
♦EN0K0UTIN£(IJM2XY) 

RETURN 

END 
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*  THIS  SUBROUTINE  LABELS  THE  COLOR  COOES  USED  IN  * 

*  THE  MAPPF.O-SECTION  DISPLAY  FILE.  * 

*********************************************************** 

REAL  LEFT 

INTEGER  *  4  LABEI.S(7,2) 

DATA  LAdELS/#F0HE','UR8A', 'MARS', 'NULL', 'MATE', 'HEAT', 
♦  'OPEN',~ST', 'N', 'H', '  ','R','H','  '/ 

INCLUDE  'WI.NDO.CMN' 

1  ************************************************************** 
1  *  FMINXY  CONTAINS  THE  X  MIN  AND  4AX  AND  THE  Y  MIN  AND  * 

t  *  MAX  RESPECTIVELY  FOR  THE  kInDOW.  MIN  AND  MAX  REFER  * 

l  *  TO  THE  MIN  AND  MAX  OF  ELEVATION  VALUES,  AND  ZDF.LT  IS  * 

1  *  THE  CONTOUR  INTERVAL.  * 

1  ************************************************************** 
1  DIMENSION  FWINXYC4) 

1  COM,MON/N[NDO/FNINXY,MIN,MAX,ZDELT 

1  ************************************************************** 
CALL  CMOPEN 

CALL  VWPORT( 0. ,40., 0., 90.3 
CALL  rtINDOM(0.,40.,0.,90.) 

CALL  TXTCLR(4) 

CALL  TXAH 

CALL  TXS I ZE(0,2.,2.) 

LEFT=5. 

RIGHTslS. 

DO  1=1,7 

BOTTOMslO. *1 
TOP=BOrTOM*8. 

CALL  LINCLRCI) 

DO  XsLEFT, RIGHT, .5 

CALL  MOVECX, BOTTOM) 

CALL  ORA W ( X , TOP) 

ENDDO 

CALL  M0VE(X,8DTT0M*5.) 

CALL  TEXTC4, LABEL SCI, 1)) 

CALL  IEXT(2,LABELS(I,2) ) 

CALL  MOVECX, BOTTOM *2 . ) 

CALL  TEXTC5, 'CODE; ') 

CALL  INUMBR (1,1) 

ENDOO 

FXsFNINXY(l) 

FYsFWINXY (3) 

CALL  MOVE(20. ,6. ) 

CALL  RNUMBR(FX,-1,8) 

CALL  MOVE( 20. , 0.  ) 

CALL  RNUM8R(FY,-1 ,8) 

R  =  1 . 

T=U 

R  =  R-*98.8*40.5 
T=r*98.8*.5 

CALL  VNP0RTC40. ,R,0. , T) 

CALu  *IND08(FNINXY(1) , FWINX Y C 2 ) , FWINX Y ( 3 ) ,FWlNXY(4> ) 
CALL  CMCLOS 
WE  njRM 
E  <u 
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-0001  SUBROUTINE  INTERS ( 1X1 , I  Y  1 , 1X2 , 1 Y 2 , HEIGH T , FR AC, ICRJSS) 

0002  ***************  *******************************  ***********  **************** 

0003  ♦  FINOS  INTERSECTION  OF  SEGMENT  XI, Y1  TO  X2,¥2  *  I TH  HEIGHT 

'0004  ************************************************************************* 

0005  *  inputs: 

000b  *  IXl,IYi,IX2,l¥2“-  INDICES  TO  2  POINTS  IN  THE  DATA  ARRAY 

0007  *  HEIGHT..  ELEVATION  OF  THE  CONTOUR  BEING  TRACED 

0008  *  OUTPUTS:  FRAC  —  FRACTION  OF  DISTANCE  FROM  P0INT1  TOWARDS  P0INT2 

0009  *  M*  H.  JONES  *** 

0010  ************************************************************************* 

0011  IMPLICIT  INTEGERS  (I-N) 

0012  C 

0013  C  *CHECK  FOR  MO  INTERSECTION 

0014  ICRJSS  s  0 

0019  zi=iELvcm,ixn 

001b  Z2sIELV(IY2,IX2) 


0017 

IFCZl 

,GE.  HEIGHT 

.AND. 

Z2  .GE.  HEIGHT) 

THEN 

0018 

GO 

T3  10 

0019 

ENDIF 

0020 

IF(Z1 

.LE.  HEIGHT 

.and. 

Z2  .LE.  HEIGHT) 

THEN 

0021 

SO 

TJ  10 

0022 

ENDIF 

0023  C 

0024  C  *C JMPU TE  INTERSECTION 

0025  ICRJSS  s  1 

0026  FRAC  =  (HEIGHT  -Zl)  /  (Z2-Z1) 

0027  C 

0028  10  RETURN 

0029  END 


SUBROUTINE  MAP2LL(FNAmE,FLQN,FLAT) 
************************************************* 
THIS  ROUTINE  COMPUTES  THE  L  AT , LON  OF  THE  * 
CENTER  JF  A  SHEET  FROM  THE  *745  SERIES.  ♦ 
************************************************* 
INPUTS:  FMAME  —  THE  NAME  OF  THE  MAP  * 

OUTPUTS:  FLON.FlAT--  REAL-VALUED  LAT  AND  * 
„  LON  OF  THE  CENTER  OF  THE  MAP  * 

************************************************* 
CHARACTER'S  FnAME 
DIMENSION  DC2) 

PARAMETER  PI=3. 141592654 
P_RAD=PI/180. 

DO  1*2, 4, 2 

UECOO£(2,10,FNAM£(I:I+1))  DCI/2) 

ENOOO 

10  FORMAT(Fi.O) 

DLATa50+(59-D(l))/2.*.2F.l 

DLONs9+(D(2)-20)/2./3.+l./6. 

FLAT=DLAT*P_RAD 

FL0N=0L3N*P_RA0 

RETURN 


0001  SU8K0UT 1 NE  4AP2UTm(FNA*E, FEAST, FN3RTH,CMERID) 

0002  *********************************************************** 

0003  *****  THIS  ROUTINE  COMPUTES  THE  OTM  CENTER  QF  A  SHEET  FROM 

0004  *****  THE  4745  SERIES, 

0005  *********************************************************** 

0006  CH ARACTER*5  FNA4E 

0007  OIMENSIJN  0(2) 

OoOB  PARAMETER  PIs3. 141592654 

0009  P_RA0sPI/18u. 

0010 

0011  03  1=2, 4,2 

0012  UECOOE(2,lO,FNAM£(i:i+l))  0(1/2) 

0013  E.4000 

0014  10  F3RMAT(F3.0) 

0015 

0016  0LAf=50*(59-0(l) )/2.*.2*.l 

0017  DL0N=9*(D(2)-20)/2./3.+l./6. 

0018  FLA  TsOLA  T*P_R AO 

0019  FL0NS0L3M*P.RA0 

0020  CALL  ADSMP(FLAr,FL0N,CMER10, FEAST, FHORTH) 

0021  FEASTsFEAST+500000. 

0022  RETURN 

0023  END 
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S'J9kOurLYt  TAPPER 

**************************************************************** 

*  calls  the  routines  ro  display  the  terrain  data  * 

**♦*♦*♦*****•♦***♦♦♦*****4 ****** ********************************* 

*  HPUTSS  NONE  ♦ 

*  outputs:  none  * 

************************* ****** ********************************* 
IMPLICIT  INTEGERS  (I-N) 

INCLUDE  'WlNDU.CMN' 

1  ************************************************************** 

1  *  FalNXY  CONTAINS  THE  X  MIN  AND  MAX  AND  THE  Y  MIN  AND  * 

1  *  MAX  RESPECTIVELY  FOR  THE  WINDOW.  MIN  AND  MAX  REFER  * 

1  *  TJ  THE  MIN  AND  MAX  OF  ELEVATION  VALUES,  AND  ZDELT  IS  * 

1  *  THE  CONTOUR  INTERVAL.  * 

1  ************************************************************** 

1  DIMENSION  FwInXY(4) 

1  common/*indo/fwinxy,min,max,zdelt 

1  ************************************************************** 
INCLUDE  *  MAP. CNN  * 

1  *********************************************************** 

1  *  I8IJF  HOLDS  A  40M0KM  ARRAY  OF  DISPLAY  DATA ,  WITH  * 

1  *  THE  FIRST  INOEX  CORRESPONDS  TO  NORTHING,  AND  * 

1  *  THE  SECOND  TO  EASTING.  * 

1  *********************************************************** 

1  INTEGER*2  IBUF(400,400) 

1  COMMON  /MAP/laUF 

1  *********************************************************** 
INCLUDE  'ANSWER. CMN# 

1  ************************************************ 

1  CHARACTERS  FEA  ,  CON 

1  CJMMON/ANSWER/FEA,CON 

1  ************************************************ 

CALL  CMOPEN 
CALL  NEWPAG 


IF(FEA.EQ. 'Y'JTHEN 
CALL  LABEL 
INCR=2 

CALL  FEATURES! INCR) 

ENDIF 

IF  C  CON . EQ . ' Y ' ) THEN 
CALL  MAXMIN 
DBRESsl 00 
ZM I NsM IN 
ZMAXSMAX 

C0NRESs400.  •  CHECK  ELEVATION  EVERY  400  M 
IF (MAX. ST. -32767. AND.MIN.LT. 32767) THEN 
CALL  CMOPEN 
CALL  LINCLKC4) 

CALL  VWPURT(40., 139.3,0. ,99.3) 

CALL  MINUOmCO., 40000. ,0., 40000.) 

CALL  DRWCON(FWINXY,DBRES,CONRES,ZNIN,ZMAX, ZDELT) 
ELSE 

CALL  CMCLOS 

PRINT*, 'NO  DATA  IN  THIS  AREA.' 

ENOIF 

ENDIF 
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SUBROUTINE  MAPIM( IR, JC,MGR,ERR) 

***************************************************************** 
READS  T  -4  A  10KM  FILE  AND  PLACES  IT  IN  THE  BUFFER,  I8UF  * 
l*************?************************************************** 
INPUTS:  * 

lR,JC  —  THE  'ROM'  AND  'COLUMN'  OF  THE  FILE,  * 

EACH  RUNS  FROM  0  TO  3  * 

MGR—  THE  MILITARY  GRID  REFERENCE  (UTM)  NAME  OF  * 
THE  FILE  TO  BE  OPENED  * 

OUTPUTS:  ERK—  AN  ERROR  FLAG  * 


*************************** 4* ******** ********* ******************** 

LJGICALM  ERR 
CHARACTER *7  MGR 
I  'ITEGER *2  ROM , COL 
INCLUDE  'CORNER. CMN' 

1  *********** ******  ****************************************** 

1  *  SMX , SM  Y  Are  THE  SOU  THMEST  UTM  COORDINATES  OF  THE  * 

1  *  AREA  IN  THE  ARRAY  IBUF.  * 

1  IMTEGERM  SMX,SMY 

1  C0MM0N/C0RNER/SMX,SrfY 

1  *********************************************************** 

INCLUDE  'MAP. CNN' 

1  *********************************************************** 

1  *  IBUF  HOLDS  A  40*40KM  ARRAY  OF  DISPLAY  DATA, WITH  * 

1  *  THE  FIRST  INDEX  CORRESPONDS  TO  NORTHING,  AND  * 

1  *  THE  SECOND  TO  EASTING.  * 

1  *********************************************************** 

1  INTEGERS  I BUF ( 400 , 400) 

1  COMMON  /MAP/IBUF 

l  *********************************************************** 

INTEGERS  SUUAREC  100, 100) 

OPEN(UNIT=9,NAME=MGR,STATUS='OLD',FORMs'UNFORMATTED',ERRslO) 
READ ( 9 ) SQUARE 

20  CONTINUE 

IRO**100*IR 
JCOLslOO*JC 
DO  J=l,100 
CQLsJCOL+J 
DO  1*1,100 
ROWalRON+I 

I BUF ( ROM , COL)=SaUARE(I,J) 

ENDDO 

ENDDO 

CL0SE(UNIT=9) 

RETURN 

10  ERR* . TRUE . 

PRINT*, 'NO  FILE:  ' , MGR 
DO  1*1,100 
00  Jal,100 

SOU ARE ( I , J } *0 
ENODO 
ENDDO 
G3T020 


0055  CNO 
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SUBROUTINE  nAPOUT( IH,JC,MGR,ERR) 

****************** ** *************************************************** 

*  REWRITES  THE  10KM  FILES.  * 

*********************************************************************** 

*  INPUTS:  *  * 

*  IR,JC— THE  '  ROW  '  AND  'COLUMN'  OF  THE  100*100  ARRAY  TO  * 

*  BE  WRITTEN;  THE  VALUES  RUN  FROM  0  TO  3  * 

*  MGR  —  THE  NAME  OF  THE  FILE  * 

*  OUTPUTS:  ERR—  AN  ERROR  FLAG  * 

*********************************************************************** 

LOGICAL* 1  ERR 
CHARACTER*7  MGR 
INTEGER*2  ROW , COL 
INCLUDE  'CORNER. CMN' 

*********************************************************** 

*  S*X,SWY  ARE  THE  SOUTHWEST  UTM  COORDINATES  OF  THE  * 

*  AREA  IN  THE  ARRAY  IBUK.  * 

INTEGER*4  SWX,SWY 

COMMON/ CORN£R/S*X,SWY 

*********************************************************** 

INCLUDE  'MAP. CMN' 

*********************************************************** 

*  IBUF  HOLDS  A  40*40KM  ARRAY  OF  DISPLAY  DATA , WITH  * 

*  THE  FIRST  INOEX  CORRESPONDS  TO  NORTHING,  AND  * 

*  THE  SECOND  TO  EASTING.  * 

*********************************************************** 

IMTEGER*2  IBUF ( 400 , 400 ) 

COMMON  /MAP/IBUF 

*********************************************************** 

INTEGER*2  SQUARE! 100, 100) 

OPEN( UNITs9,NAME*MGR,STATUS= 'UNKNOWN', FORMS' UNFORMATTED', ERH  =  10) 

IROWslOO*IR 
JCOLslOO* JC 
DO  Jsl , l 00 
COLsJCOL+J 
DO  Isl,100 
ROWslROW*! 

SQUARE! I, J)slBUF( ROW, COL) 

EnDOO 

ENDDO 

WRITE!9) SQUARE 
CLOSEIUN I T*9) 

RETURN 

10  ERRs.TRUF. 

PHIN  r * , 'ERROR  ON  OPENING  FILE  ' , MGR 

RETURN 

END 
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SUBROUTINE  MAXMIN 

********************************************************* 

*  FINOS  THE  MAX  AND  MIN  ELEVATION  VALUES  IN  THE  * 

*  DATA  ARRAY.  * 

$4***** ********************************  ****************** 

IMPLICIT  INT£GER*2  (I-N) 

CHARACTER  *  1 4  NAMEF 
INCLUDE  'NINDO.CMN' 

1  ************************************************************** 

1  *  FNlNXY  CONTAINS  THE  X  MIN  AND  MAX  AND  THE  Y  MIN  AND  * 

1  *  MAX  RESPECTIVELY  FOR  THE  tflNDQ*.  MIN  AND  MAX  REFER  * 

1  ♦  TO  THE  MIN  AND  MAX  OF  ELEVATION  VALUES.  AND  ZDELT  IS  * 

1  *  THE  CONTOUR  INTERVAL.  * 

1  ************************************************************** 

1  DIMENSION  FNINXYC4) 

1  COMMON/NINDU/FWINXY.MIN.MAX.ZDELT 

1  ************************************************************** 
INCLUDE  'MAP.CMN' 

1  *********************************************************** 

1  *  I dUF  HOLDS  A  40*40M  ARRAY  OF  DISPLAY  DATA. MlTH  * 

1  *  THE  FIRST  INOEX  CORRESPONDS  TO  NORTHING.  AND  * 

l  *  THE  SECONO  IQ  EASTING.  * 

1  *********************************************************** 

1  INTEGERS  IBUF( 400 , 400 ) 

1  COMMON  /MAP/IBUF 

1  *********************************************************** 
MINs32767 
MAXs-32767 
Xl*l 
X2S400 
Y  3*1 
Y4*400 

C  IN  THE  INTEREST  OF  TIME, ONLY  EVERY  FOURTH  POINT  IS  CHECKED 

X  =4  . 

Y*4. 

DO  J*X1.X2.X 
DO  I*Y3.Y4.Y 

IMINsMINOIIELVd,  J)  ,MIN) 

MAXsMAXO ( 1ELV (I.J).MAX) 

IF(IM1N.GT.0)THEN 

MINsiMIN 

ENDIF 

ENDDO 

ENOOO 

RETURN 


0001  SUBROUTINE  OPENERS 

0002  ***********  **************** *********1********** ********** 

OOOJ  *  HIS  ROUTINE  SIMPLY  OPEnS  THE  GRID, NODE, LINK,  AND  * 

0004  *  SodNOOE  FILES,  A No  THE  ISAM  FILE  *H1CH  CONTAINS  * 

0005  *  THE  'HEXISED'  LOC  OR  HYDRO  DATA  ♦ 

0006  ********************************************************* 

000  7  OPEN ( UN  I Tsl, NAMEs 'GRID', TYPEs 'OLD', READONLY, SHARED, 

0008  *ACCESSs 'DIRECT', BLOCK SIZEs2000) 

0009  OPEN (UNI Ts2, NAMEs 'NODE', TYPEs 'OLD', READONLY, SHARED, 

0010  ♦ACCESSs'DIRECT',BLOCKSI2£s2000) 

00 n  OPEN ( UN I r»3, NAMES 'ROAD', TYPES 'OLD', READONLY, SHARED, 

0012  * ACCESSs 'DIRECT', BLOCKSIZ£s2000) 

0013  OPEN ( UN  I Ts4, NAMEs 'SUbN', TYPEs 'OLD', READONLY, SHARED, 

0014  * A CCESSs 'DIRECT' , BLOCK SIZEs 2 000 ) 

0015  * 

OOlo  *  NOW  FOR  THE  ISAM  FILE 

0017  OPEN ( UN ITs7, NAMES 'HEX ROAD ',STATUSs 'UNKNOWN', 

0018  «-  ORGANIZATION  s'InDEX£D',ACCESS='KEYED',RECLs2, 

0019  *  R£COROTYPEs'FlXEO',FORMs'UNFOKMATTED', 

0020  ♦  KEYs(ls4:iNTEGER) ) 

0021  RETURN 

0022  END 
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SUBROUTINE  PACKER (HEX, HSIDE, IADJ,LU) 
***************************************************** 
THIS  PACKS  THE  MAX  VALUE  OF  CONNECTIVITY  'TYPE' 

AT  'SIUE'  JF  THE  HEX  InTQ  THE  APPROPRIATE  OISIT 
OF  'SIDES' 

*** * ********  * ************************* *************** 

*  INPUT: 

*  HEX  — INTERNAL  HEXI 

«  HSIDE  —  HEX  SIDE  CURRENTLY  BEING  PROCESSED 

*  IADJ—  ERROR  FLAG  DENOTING  THAT  THE  DIFFERENCE 

*  IN  THE  TwO  HEXES  WAS  TOO  LARGE 

*  ojtput: 

*  HEX 

*  HSIDE 

«  SIDE—  DECIMAL  NUMBER  OF  THE  SIDE;  RANGE:  1  -6 

*  SIDES—  THE  PACKED  CONNECTIVITIES  OF  THE  HEX 

**********************************  ************  ******* 


IMPLICIT  INTEGER  (H,P) 

INTEGERM  TOP, TMP, BOTTOM, SID9,SID10, SIDE, HSIDE 
INCLUDE  'PACKER. CNN' 

********************************************************** 

INTEGERM  SIDES  !  PACKED  CONNECTIVITIES  « 

INTEGERM  LTYPE  1  CONNECTIVITY  FOR  CURRENT  SIOE  * 
COMMON/PACK/SIDES, LTYPE 

********************************************************** 
D  PRINT*, 'LU  IN  PACKER', LU 

C 

C***»*  IADJsl  IF  THE  HEXES  WERE  ADJACENT; IE  IF  THEIR 
C***»*  VECTOH  DIFFERENCE  IS  FROM  1  TO  6,  AND  0  IF  NOT 
IADJsl 

CALL  STRIPPER(HSIO£,SID£) 

IF(SIDE.LE.O) THEN 
AADJsO 
RETURN 
ENDIF 

SID9=10**(SI0E-1) 

SIDlOslOMSIDE 


STRIP  OFF  THE  UPPER  DIGITS 
T0PsINT(SIDES/SID10)*SID10 

NOW  GET  THE  LOWER  ONES 
TMPsSIDES-TOP 
I SIDE* I NT ( IMP/ SI 09) 
8JTrOMsTMP-ISIDE*Sl09 

RESET  THE  VALUE  FOR  THE  CONNECTIVITY 
ITYPE*MAX(ISIDE, LTYPE) 

REPACK 

SlDES*TJPtITYPE*SID9*B0TTOM 
CALL  HEXWRITEIHEX, SIDES, LU) 

RETURN 

END 
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SUBROUTINE  REPACK(HSTGR,LTYPE) 

*  REPACKS  THE  CONNECTIVITY  OR  HYDRO  LEVELS  FOR  A  HEX  ♦ 

*^tt ***************************************************  ******* 

*  INPUTS:  HSTUR —  INTERNAL  HEX  NUMBER  ♦ 

*  LTYPE  —  LOC  Ok  HYDRO  LEVEL  AT  THE  GIVEN  SIDE  ♦ 

************************************************************** 
IMPLICIT  I N  TEGER ( H » P ) 

I4TEGERM  SIDES 


0010 

DIMENSION  HST3R(2) ,HXSI0£(2) 

0011 

IMCLUDE'UnPACK.CMn' 

0012 

1 

***************************************************** 

* 

0013 

1 

IMTEGERM  HSIUE(6)  !  CONNECTIVITY  CODES 

IN 

r 

0014 

1 

i  NUMERICAL  order  by 

SIDE 

* 

0015 

l 

COMMON/ JN PACK/HSIDE 

0016 

1 

****************  **************************** 

* 

0017 

HXSIDE(l)=HXAJ0(HSTaRl2) , HXIN V ( HSTOR ( 1 ) ) ) 

0018 

HXS1DEC  2)sHXINV(HXSIDE(  l) ) 

0019 

LU  =  7 

0020 

DO  jsl,2 

0021 

CALL  HEXREAO(HSrQR(J), SIDES, LU) 

0022 

CALL  UNPACKER(SIDES) 

0023 

CALL  STRIPPER(HXSIDE(J),ISIDE) 

0024 

HSIDECISIDEJsLTYPE 

0025. 

NEWSIDEsO 

002b 

DO  1=1, b 

0027 

NENSIDE=NENSIOE+HSIDE(I)*10**(I-1) 

0023 

ENOOO 

0029 

CALL  HEXWRITECHSTORC J) ,NEWSIDE, LU) 

ENDDO 

0031 

RETURN 

0032 

END 

I 
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SUBROUTINE  RlJ2IJ(RI,RJ,I,  J) 

RJUTInE(CJNVER  T  REAL  TO  NEAREST  INTEGER  I,J  COORDINATES  -  RIJ2IJ) 
t**?***********#******************************************#****** 

DESIGNER/ PROGRAMMER! 

DON  KRECKER  17  SEPTEMBER  1980 
PURPOSE : 

RIJ2IJ  TAKES  A  POINT  SPECIFIED  BY  REAL-VALUED  OBLIQUE 
COORDINATES  (RI,RJ)  AND  DETERMINES  THE  NEAREST  POINT  -ITH 
INTEGER-VALUED  OBLIJLE  COORDINATES  (I,J).  ALL  TIES  ARE 
RESOLVED  IN  FAVOR  OF  THE  POINT  *ITH  THE  LARGER  l  AND/OR  J 
COORDINATE. 

THE  SlSl'EM  OF  INTEGER  I ,  J  ObLIOUE  COORDINATES  CORRESPONDS 
TJ  THE  SET  OF  HEX  CENTERS  IN  A  HEXAGONAL  GRID.  -HEN  COM¬ 
PUTATIONS  ON  SUCH  A  GRID  LEAD  TO  POINTS  OTHER  THAN  HEX 
CENTERS,  IT  IS  OFTEN  NECESSARY  TO  DETERMINE  -HICH  HEX  CON¬ 
TAINS  TmE  COMPUTED  POINT.  THE  HEX  CONTAINING  THE  POINT  IS 
THE  ONE  WHOSE  CENTER  IS  CLOSEST  TO  THE  POINT.  THUS  THE 
PROBLEM  REDUCES  TO  FINDING  THE  POINT  - I TH  INTEGER  I,J 
COORDINATES  WHICH  IS  CLOSEST  TO  A  GIVEN  POINT  - ITH  REAL 
I,J  COORDINATES.  BECAUSE  THE  AXES  IN  THE  OBLIQUE  COORDI¬ 
NATE  SYSTEM  ARE  NUT  ORTHOGONAL,  IT  IS  NOT  ALWAYS  CORRECT 
TO  SIMPLY  ROUND  THE  REAL  I  AND  J  COORDINATES  TO  THE  NEAR¬ 
EST  INTEGERS.  RIJ2IJ  IMPLEMENTS  THE  PROPER  TRANSFORMATION. 
GIVEN  R I  AND  HJ,  THE  ALGORITHM  FIRST  FINDS  THE  GREATEST 
INTEGERS  LESS  THAN  OR  EQUAL  TO  THEM,  NAMELY  10  AND  JO. 

THIS  DETERMINES  A  RHOMBUS  CONTAINING  (R1,RJ)  WITH  VERTICES 
(10, JO),  (10*1, JO),  (I0+1,J0+1),  AND  (I0,J0+1).  IN  OKDEP 
TO  DECIDE  WHICH  VERTEX  IS  CLOSEST  TO  (RI,RJ),  THE  RHOMBli 
IS  DIVIDED  INTO  BANDS  OF  -luTH  1/2  PERPENDICULAR  TO  THg 
I,  J,  AND  K  AXES.  THERE  ARE  THREE  I-BANDS  NUMBERED  0,  1, 
AND  2  In  THE  OiNECTION  OF  THE  POSITIVE  I-AXIS.  LIKEWISE, 
THERE  ARE  THREE  J-BANDS.  THERE  ARE  ONLY  2  K-BA  NDS  NUM¬ 
BERED  0  AND  1  IN  THE  DIRECTION  OF  THE  NEGATIVE  K  AXIS. 

ONCE  THE  I,  J,  AND  K  BAND  NUMBERS  FOR  (Rl,RJ)  HAVE  BEEN 
COMPUTED,  THE  COORDINATES  (I,J)  OF  THE  PROPER  VERTEX  ARE 
GIVEN  BY: 

I  :  10  t  (IBAND+KBAND)/2 
J  s  JO  ♦  (JBAND+KBAND)/2 
CALLING  SEQUENCE: 

CALL  KiJ2lJ(RI,RJ,I,J) 


INPUT: 

Rl 

RJ 

OUTPUT: 

I 

J 


-  REAL-VALUED  I  ( 

-  REAL-VALUED  J  ( 

-  INTEGER-VALUED 

-  INTEGER-VALUED 


COORDINATE 

COORDINATE 

)  I  COORDINATE 
)  J  COORDINATE 


***«♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦ 
IMPLICIT  INTEGERS, P) 

♦COMPUTE  GREATEST  INTEGERS  LE  RI  AND  RJ 
10  s  IFIX(RI) 

JO  s  IFIX(RJ) 

IFCRI.LT.FLOAT(IO) )  10  a  10  -  1 
IF(RJ.LT.FLOATUU)  )  JO  s  JO  -  1 
♦FIND  NJNNEGATIVE  FRACTIONAL  PARTS  OF  RI  AND  RJ 
FI  *  RI  -  FLOAT(IO) 
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0058  FJ  =  RJ  -  FLJAf(jO) 

0050  C  *CcMPUT£  I,  J,  AND  K  BAND  NUMBERS 

0060  18AND  =  IF1X(FI  ♦  FI  -  FJ  ♦  1.0) 

0061  J9AND  s  I  FI  X ( F  J  ♦  FJ  -  FI  ♦  1.0) 

0062  KBAND  =  iFIXCFI  ♦  FJ) 

0063  C  *DE'f  ERM INE  NEAREST  INTEGER  08LI0UE  COORDINATES 

0064  I  =  10  f  ISHFT(IBAND>KBAND,-1) 

■006b  J  =  JO  +  ISHFT(  JBANO+KBANO,-!) 

0066  C  *ENDR0(IT1N£(RIJ2I  J) 

0067  RETURN 

0068  end 
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0001  SUBROUTINE  SE  TGEO 

0002  ******************************************************* 

OOOJ  *  THIS  ROUTINE  SETS  THE  GEOGRAPHIC  PARAMETERS  * 

0004  *  REEDED  TO  RUM  THE  LAT/LON-->U I'M  STUFF.  * 

0005  ******************************************************* 

0000  INCLUDE  'CRriRiO.CMN' 

0007  1  **************************************************** 

0008  1  REAL*8  CMERID 

0009  1  REAL  P-RAD 

0010  1  CJMMON/CMERlD/CMERlD, P-RAD 

0011  1  ***************** *********************************** 

0012  INCLUDE  'UTIL:ZOBPRQ.CMN' 

00100  0013  1  C 

00200  0014  1  C  DUMMY  COMMON  ZDBPRO 

00300  0015  1  C 

00400  0016  1  INTEGERM  ZRFOAY , ZIOCNT, ZYOOG,ZTSEC( 4 ) , ZTEX C 5 ) 

00500  0017  1  INTEG£R*2  ZSPHID, ZYGOAT, ZTSN , ZRGN , ZHGL,  ZM3RST( 3 , 3 ) , ZLLST (  56 ) 

00600  0018  1  LJGICALM  ZTSIC ( 3 ) , ZTDWN ( 25 ) 

00700  0019  1  C 

00800  0020  1  COMMON  /ZDBPRO/  ZRFDAY , ZIDCNT, ZYDOG, ZTSEC, ZTEX , 

00900  0021  1  2  ZSPHID, ZYGOAT, ZTSN  , ZRGN  ,ZTSIC, 

01000  0022  1  3  Z  TDmN  ,ZRGL  ,ZMGRST, ZLLST 

01100  0023  1  C 

0024  PARAMETER  PI=3. 141592654 

0025  P_RAD=PI/180. 

0026  ZSPtilOsl  i  INTERNATIONAL  SPHEROID  (?) 

0027  ZRGNS32  !  UtM  ZONE  FOR  MOST  OF  EUROPE 

0028  CALL  ADSCCM(ZRGN,CM£RID)  1  SET  CENTRAL  MERIOI AN 

0029  CALL  AOSSSP(ZSPHID)  !  SET  SPHEROID  IN  ADCEAR • CMN 

0o30  END 
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c***»* 

SdrtnOUT I Nt  STRIPPER(HSID£, ISIDE) 

*********************************** 

ms  routine  accepts  a  hex  vector  in 

[  <TERnAL  F3RMhT, CONVERTS  IT  TO  EXTERNAL 
FORMAT  ANo  THEN  STRIPS  OFF  THE  LEADING 
7'S. 

*********************************** 

Input:  hside— the  hex  side  in  internal 

FORMAT 

OUTPUT:  ISIDE—  THE  HEX  SIDE  AS  A  DECIMAL 
DIGIT 

*********************************** 
IMPLICIT  1NTEGER(H,P) 

PARAMETER  H7=77777770 

CONVERT  THE  INTERNAL  HEX  »  TO  DECIMAL 
CALL  H£XOJT( HSIOE, 1 # ISIDE) 

ISIDE=ISIDE-H7 

RETURN 

End 
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SUBROUTINE  TRACE  ( I X , 1Y , IENTER , 1T0P , HEIGHT , MASK , 

S  XYDELTA, ILL, I UR, JLL, JUR, I JOELTA) 

** ** ** ** ****************  ** ****************************  ******  ******* 
TRACES  CONTOUR  UNTIL  *IND0W  EDGE  OR  CLOSURE. 

CONTOUR  ENTERED  RES.  ELEMENT  "IX, IT"  FROM  SIDE  "IENTER" 
******************************************************************* 
INPUTS: 

IX, IT—  INDICES  OF  CURRENT  RESOLUTION  ELEMENT 
IENTER--  THE  SIDE  OF  THE  ELEMENT  ENTERED  Cl, 2, OR  3) 
ITOP  —  A  FLAG  (0  UPON  ENTRT)  WHETHER  THE  T  INDEX  HAS 
REACHED  THE  "TOP"  OF  THE  ARRAT 
HEIGHT--  THE  ALTITUDE  OF  THE  TRACE 

MASK—  AN  ARRAT  OF  FLAGS  INIDCATI NG  THE  STATUS  OF  EACH 
SIDE  OF  EACH  ELEMENT  CO-NOT  CHECKED, 

1-INTERCEPT, 10-N0  INTERCEPT) 

XTDELTA--  HORIZONTAL  DISTANCE  BETWEEN  CONTOUR  INTERVAL 
CHECKS 

ILL, IUR--  LOWER  LEFT  AND  UPPER  RIGHT  LIMITS  TO  THE  ROW 
INOEX 

JLL, JUR—  SAME  FOR  THE  COLUMN  INDEX 

I JOELTA--  RATIO  OF  THE  CONTOUR  ELEMENTS  TO  THE  DATA 
ELEMENTS 

OUTPUTS:  NONE 
***  H. JONES  *** 

******************************************************************* 
IMPLICIT  INTEGER*2  (I-N) 

INCLUDE  'MASK. DIM' 

******************************************************** 

BITE  MASK(400,400,3) 

******************************************************** 

10  CONTINUE 


I  F  (  I X 

. LT .  ILL  .OR. 

IX 

.GT. 

IUR) 

THEN 

GO 

TO  20 

ENDIF 
IF(  I Y 

• LT .  JLL  .OR. 

IY 

.GT. 

JUR) 

THEN 

GO  TO  20 
EMOIF 
C 

I F  C IENTER  .NE.  1)  THEN 
IFIITOP  .EO.  0)  THEN 
IYIND  =  IX 
ELSE 

IYIND  a  I Y+I JOELTA 
ENOIF 

IF(MASK(IX, IYIND, 1)  .EQ.  0)  THEN 
CALL  INTERS (IX, IYIND, IX* 

$  I JOELTA, IYIND, HEIGHT, FRAC,ICROSS) 

IFC ICROSS  .EQ.  1)  THEN 

XsFLOAT(IX/I JOELTA )*XYDELTA 
XX  *  X  ♦  XYDELTA  *  FRAC 
YYaFLOATt IYIND/ I JOELTA) *XYDELTA 
D  CALL  CMCLOS 

D  PRINT*, XX, YY,'  TRACE' 

D  CALL  CMOPEN 

CALL  DRAW  (XX, YY) 

MASK(IX,IYINJ,1)  a  1 


B-204 


TRACE 


0058 

IT  s  IYI.NO  -  IjntuLTA  ♦  ITOP* IJDELTA 

0059 

ienter  =  l 

0060 

ITJP  si-  irop 

0061 

SO  TO  10 

0062 

ELSE 

0063 

MASK( IX,IYIN0,1)  r  10 

0064 

ENDIF 

0065 

£NDI  F 

0066 

ENOIF 

0067 

c 

0068 

IF( IENTER  •  NE.  2)  THEN 

0069 

1FCIT0P  .EO.  0)  then 

0070 

IXINO  =  IX 

0071 

ELSE 

0072 

IXINO  *  IX+IJOELTA 

0073 

ENDIF 

0074 

IFCNASKC IXINO, IT, 2)  .EO.  0)  THEN 

0075 

CALL  INTERS(IXIND,IY, IXINO, IY+ 

0076 

♦  IJOELTA, HEIGHT, FRAC, ICROSS) 

0077 

IF ( I CROSS  .£Q.  1)  THEN 

0078 

XXsFLOATC IXINO/ IJDELTA )*XYDELTA 

0079 

TafLOATI IT/I JDELTA )*XYDELTA 

0080 

YY  a  Y  ♦  XYOELTA  *  FRAC 

0081 

call  Oran  (Xx,yy> 

0082 

4ASK(IXIN0,IY,2)  s  1 

0083 

IX  a  IXINO  -  IJDELTA  ♦  ITOP* I JDELTA 

0084 

IENTER  s  2 

0085 

ITOP  a  1  -  ITOP 

0O8o 

30  TO  10 

0087 

ELSE 

0088 

NASK(IXIN0,IY,2)  a  10 

0089 

ENDIF 

0090 

ENDIF 

0091 

ENOIF 

0092 

c 

0093 

IFIIENTER  .NE.  3  .AND.  MASK (IX,IY,3)  .EQ.  0) 

0094 

CALL  INTERS(IX,IY*IJDELTA,IX+ 

0095 

$  IJOELTA, IT, HEIGHT, FRAC. ICROSS) 

0096 

IFCICROSS  .EQ.  1)  THEN 

0097 

XsFLOATI IX/ IJDELTA) *XYDELTA 

0098 

YsFL0AT(IY/lJ0ELTA4ll*XY0ELTA 

0099 

XX  a  X  ♦  XYDELTA  *  FRAC 

0100 

YY  a  Y  -  XYOELTA  *  FRAC 

0101 

CALL  ORAN  (XX, YY) 

0102 

MASK(IX,IY,3)  *  1 

0103 

c 

0104 

IENTER  a  3 

0105 

ITOP  a  1  -  ITOP 

0106 

GO  TO  10 

0107 

ELSE 

0108 

MASK (IX,IY,3)  a  10 

0109 

ENOIF 

0110 

ENOIF 

0111 

c 

0112 

2  ■  R ETORN 

0113 

END 

THEN 
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FUNCTION  r«ANA(X) 


OOOl 

0002  C 

0003  C  TRANSLATES  THE  X  VALUES  STOKED  IN  THE  NODE  AND 

0004  C  SUBNODE  RECORDS  OF  THE  BON  DATA  FILES  BACK  TO 

0005  C  STANDARD  UTM  COORDINATES. THE  STURED  DATA  HAS  HAD 

0006  C  500,000*  SUBTRACTED  AND  BEEN  DIVIDED  BY  20, SO... 

000/  1 3 TEGER  *2  X 

0008  < 1 =X 

0009  C  D  CALL  CMCLDS 

0010  C 

0011  TRANXs20*Xl+500000 

0012  C  0  PRINT*, 'X',X, TRANX 

0013  C  0  CALL  CHJPEN 

0014  RETURN 


FUNCTION  f R AN  Y ( Y ) 


0001 

0U02  C 

OOOJ  C  TR  AncJLA TES  THE  Y  VALUES  STORED  IN  THE  NODE  AND 

0004  C  SJB4QDE  RECORDS  Of  THE  RDM  DATA  FILES  BACK  TO 

0005  C  STANDARD  UTM  COORDINATES. THE  STORED  DATA  HAS  HAD 

0006  C  5, 600,0 00 N  SUBTRACTED  AND  BEEN  DIVIDED  BY  20,SO... 

0007  C 

0008  I N TEGER  *2  Y 

0009  Y1  =  Y 

0010  TRAnY  =  20*Y1+,5600000 

0011  C  D  CALL  CNCLJS 

0012  C  D  PRINT*, #Y',Y,TR ANY 

0013  C  .0  CALL  CMOPEN 

0014  RETURN 

0015  END 
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SUBROUTINE  JNGEN 
**************************************************** 

*  THIS  ROUTINE  GENERATES  THE  FILE  NAMES  AND  * 

*  RELATIVE  INDICES  FOR  PLACING  THE  FILE  * 

*  DATA  INTO  THE  ARRAY  IBUF.  * 

***************************************  *******  ****** 

INCLUDE  'CORNER. CNN' 

1  *********************************************************** 
1  *  S*  X , SHY  ARE  THE  SOUTHWEST  UTM  COORDINATES  OF  THE  * 

1  *  AREA  IN  THE  ARRAY  IBUF.  * 

i  integer**  s«x,s*y 

1  COMMOM/CORNER/SRX,S*Y 

1  *********************************************************** 
CHARACTER*?  MGR  • 

LOGICAL* 1  ERR 
DO  J  =  0 , 3 

IEAST3SWX«>J*10000 
DO  1=0,3 

N3RTH=S*Y+I*10000 

CALL  UTM 2 MGR (IEAST, NORTH, MGR, ERR) 

CALL  MAPINCI, J, MGR, ERR) 

ENODO 

EMDuO 

RETURN 


t 


n  o 


SUBROUTINE  UNPACKEK(SI0E3) 

c***************************************** 
c*****  this  routine  is  designed  to  unpack 
C***M  the  connectivity  cooes  from  the  data 

C*****  IN  THE  ISA*  file  CREATED  BY  ROADHEXER. 
C******************«********************** 

C*****  INPUT:  SIDES  — THE  PACKED  CONNECTIVITY 
C*****  CODES 

C *****  JdTPUT:  HSIDEI6)— THE  UNPACKED  CONNEC- 
C*****  TIVITY  COOES 

C***************************************** 

C 

IMPLICIT  INTEGER  (H,P) 

INTEGERM  SIDES 
INCLUDE  'UNPACK. C*N' 

1  ****************************************************** 
1  INTEGERM  H3IDE(6)  i  CONNECTIVITY  CODES  IN  * 

1  •  NUMERICAL  ORDER  BY  SIDE  * 

1  CDHMO.n/UNPACK/HSIDE 

1  *********************** ************************ ******* 

IN  ORDER  TO  AVOID  CHANGING  'SIDES' 

ISIDESsSIDES 
DO  1=6, 1,-1 

IEXP=li)**(I-l) 

HSIDE(I)=INT(ISI0ES/IEXP) 
ISID£S=ISIDES-HSIDE (I)*IEXP 
ENDDO 
RETURN 
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SUBROUTINE  XY2IJM(X,Y,I,  J) 

*  RJUriNE(CO'WEHr  X,Y  T3  MIN  LEVEL  1,J  COORDINATES  -  XY2IJM) 

t$4***************^***************************^*4***************** 

*  DESIGNER/PROGRAMMER: 

*  DON  KhECKER  20  SEPTEMBER  1980 

*  PURPOSE : 

*  XY2I J  M  COWER  fS  A  PAIR  OF  X,Y  CARTESIAN  COORDINATES  EX- 

*  PRESSED  IN  METERS  TO  I,J  OBLIQUE  COORDINATES  AT  THE  MINI- 

*  MUM  HEX  LEVEL.  THE  RESULT  IS  THE  PAIR  JF  INTEGER-VALUED 

*  I, J  COORDINATES  CORRESPQNDI NG  TO  THE  CENTER  OF  THE  MINIMUM 

*  LEVEL  HEX  WHICH  CONTAINS  THE  GIVEN  POINT.  THIS  ROUTINE  IS 

*  THE  INVERSE  OF  THE  SUBROUTINE  IJM2XY. 

*  ThE  CONVERSION  IS  CARRIED  OUT  BY  FIRST  APPLYING  A  LINEAR 

*  TRANSFORMATION  (IN  THE  FORM  OF  A  MATRIX  MULTIPLICATION)  TO 

*  THE  X,Y  VECTOR  TO  OBTAIN  A  PAIR  OF  REAL-VALUED  I,J  COJRQI- 

*  NATES.  THE  RESULT  IS  THEN  ROUNDED  TO  THE  NEAREST  INTEGER- 

*  VALUED  i,J  COORDINATES  BY  THE  ROUTINE  RIJ2IJ. 

*  CALLING  SEQUENCE; 

*  CALL  X Y2I JM(X , Y, I , J) 

*  INPUTS 

*  X  ,  Y  -  REAL-VALUED  CARTESIAN  COORDINATES  EXPRESSED  IN 

*  MEIERS  WHICH  ARE  TO  BE  CONVERTED  TO  OBLIQUE  COOR- 

*  DIN AXES  AT  THE  MINIMUM  HEX  LEVEL 

*  RIOFX  -  REAL  I  COORDINATE  OF  THE  VECTOR  (X,Y)  a  (1,0). 

*  (IN  COMMON/HEX/) 

*  RJUFX  -  REAL  J  COORDINATE  UF  THE  VECTOR  (X,Y)  a  (1,0). 

*  (IN  COMMON/HEX/) 

*  RIOFY  -  REAL  I  COORDINATE  OF  THE  VECTOR  (X,Y)  a  (0,1). 

*  (IN  COMMON/HEX/) 

*  RJOFY  -  REAL  J  COORDINATE  OF  THE  VECTOR  (X,Y)  a  (0,1). 

*  (IN  COMMON/HEX/) 

*  OUTPUTS 

*  I,J  -  INTEGER-VALUED  OBLIQUE  COORDINATES  CORRESPONDING 

*  TO  THE  CENTER  JF  THE  MINIMUM  LEVEL  HEX  CONTAINING 

*  THE  GIVEN  X , Y  POINT 

^t************ ******************************************  ********** 
IMPLICIT  INTEGEK(H,P) 

COMMON /HEX/ I HXOU T, NHLEV ,MINL£V,SLT0,CLT0,ULN0,DIAM(10),DIAMT 
SR, 

*  XOFI,YDFI,XOFJ,YOFJ, RIOFX, RJOFX, RIOFY, RJOFY, 

t  ICON (70) , JCON(70) ,IMAX(7) , JMAX(7) 

DIMENSION  IVAL(7),JVAL(7) 

EQUIVALENCE! IVAL(1),IC0N(1)),(JVAL(1),JC0N(1)) 

*  TRANSFORM  X,Y  COORDINATES  TO  EQUIVALENT  REAL-VALUED  I,J  PAIR 
R I  a  RIOFX  *  X  ♦  RIOFY  *  Y 
RJ  a  RJOFX  *  X  ♦  RJOFY  *  Y 

♦INCLUOECCONVERT  REAL  I,J  COORDINATES  TO  INTEGER  -  RIJ2IJ) 

CALL  01J2IJ(RI,RJ,1, J) 

*£NDR0UriNg(XY2IJM) 

RETURN 

END 
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SUBROUTINE  XYU2HA(X,Y, LEV, HADR) 

♦RjUriNEtCDMvEHT  X,Y  COORDINATES  AND  LEVEL  TO  HEX  ADDRESS-X YL2HA) 
*************************  ***************************************** 

*  JESIGNER/PROGRAMMER: 

*  DON  KRECKtR  21  SEPTEMBER  1980 

*  PURPOSES 

*  XYL2HA  TAKES  A  POINT  EXPRESSED  IN  X,*  CARTESIAN  COORDINATES 

*  IN  METERS  AND  COMPUTES  THE  ADDRESS  OF  THE  HEX  AT  THE  SPECI- 

*  FIED  LEVEL  WHICH  CONTAINS  THE  POINT.  IF  THE  SPECIFIED  HEX 

4  LEVEL  IS  GREATER  THAN  THE  MINIMUM  HEX  LEVEL ,  THE  COMPUTED 

*  HEX  MAT  DIFFER  FROM  THE  HEX  (AT  THIS  LEVEL)  WHOSE  CENTER  IS 

*  CLOSEST  TJ  THE  GIVEN  POINT.  THE  REASON  IS  THAT  HEXES  AT 

4  HIGHER  LEVELS  OF  AGGREGATION  ARE  NOT  TRUE  REGULAR  HEXAGONS 

4  BUT  ONLT  APPROXIMATE  REGULAR  HEXAGONS  IN  SHAPE.  XYL2HA  IS 

4  the  Inverse  of  the  subroutine  ha2Xyl,  which  converts  a  hex 

4  ADDRESS  TO  THE  X,Y  COORDINATES  OF  THE  CENTER  OF  THE  HEX. 

4  XYL2HA  FIRST  CALLS  THE  ROUTINE  XY2IJM  TO  CONVERT  THE  X , Y 

4  COORDINATES  TO  I ,  J  OBLIOUE  COORDINATES  AT  THE  MINIMUM  HEX 

4  LEVEL.  THEN  THE  FUNCTION  IJM2HA  IS  USED  TO  CONVERT  THE  I,J 

4  COORDINATES  TO  A  HEX  ADDRESS  AT  THE  REQUESTED  LEVEL.  ERROR 

4  CHECKING  IS  DONE  BY  THIS  SUBORDINATE  FUNCTION. 

4  CALLING  SEQUENCE: 

4  CALL  XYL2HA(X,Y, LEV, HADR) 

4  input: 

4  X,Y  -  KEAL-VALUEO  CARTESIAN  COORDINATES  EXPRESSED  IN 

4  METERS  OF  A  POINT  WHOSE  CONTAINING  HEX  AT  A  SPE- 

4  CIFIEO  LEVEL  IS  TO  BE  COMPUTED 

4  LEV  -  LEVEL  OF  AGGREGATION  OF  THE  HEX  ADDRESS  TO  BE 

4  COMPUTED 

4  OUTPUT: 

4  HADR  -  ADDRESS  OF  THE  HEX  AT  THE  REQUESTED  LEVEL  WHICH 

4  CONTAINS  THE  GIVEN  X,Y  POINT 

4444 444444*4444444444444*444444444444444444444 4* 4444444444444*4444 

IMPLICIT  INTEGER(H,P) 

4INCLUDE( CONVERT  X,Y  TO  MIN  LEVEL  I,J  COORDINATES  -  XY2IJM) 

CALL  X  Y2I JM ( X , Y , I , J ) 

4 INCLUDE (CON VERT  MIN  LEVEL  I,J  AND  LEVEL  TO  HEX  ADDRESS -IJM2HA) 
HADR  s  I JM2HA(I, J,LEV) 

4EN0R0UT1N£(XYL2HA) 

RETURN 

END 


HEX  Terrain  Codes 


Terrain  Roughness 

1  =  terrain  slope  avg>.03  overall  or=15%  hills  or  rugged  terrain 

2  =  terrain  slope  avg>.06  overall  or*40%  hills  or  very  rugged  terrain 

3  =  terrain  slope  avg>1  or  most  of  hex  impassable  to  vehicles 


Roads: 

Roads  do  not  always  correspond  one  to  one  with  actual  highways,  but  rather  indicate 
the  extent  to  which  two  hexes  are  connected. 


Autobahn:  I  3 

Primary:  -  2 

Secondary: - —  -  1 

Figure  C-l 
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THE  HEXAGONAL  COORDINATE  SYSTEM 


In  the  ICOR  simulation  the  plane,  or  surface  of  the  earth  on  which 
units  move  and  fight,  is  broken  up  into  discrete  points  as  a  means  of 
organizing  the  data  base  and  the  operation  of  the  model.  Thus,  it  is 
possible  to  refer  to  all  units  and  terrain  as  being  at  a  particular  loca¬ 
tion,  meaning  in  the  neighborhood  of  a  given  discrete  point.  This  allows 
the  locations  of  units  and  terrain  features  to  be  represented  in  the  model 
much  more  compactly  than  would  be  possible  if  they  were  represented,  for 
example,  as  a  floating  point  coordinate  pair  on  a  cartesian  plane  along 
with  given  shapes.  More  important,  the  discrete  points  provide  a  means  of 
reference  as  in  the  expression  "all  units  at  location  X".  Thus,  each  point 
can  be  represented  in  the  computer  as  a  block  in  a  data  structure,  which 
contains  terrain  information  about  the  neighborhood  at  that  point,  and  a 
list  of  units  in  that  neighborhood. 

A  hexagonal  grid  has  been  chosen  as  a  means  of  defining  the  points,  or 
neighborhoods,  so  represented.  This  has  several  advantages.  The  most 
important  is  that  in  a  hexagonal  grid,  any  neighborhood,  or  hexagon,  which 
is  adjacent  to  another  also  shares  a  side  of  finite  length.  This  is  not 
true  with  a  square  grid,  where  neighborhoods  can  be  adjacent  at  a  corner. 
This  eliminates  the  tactical  problem  of  a  unit  moving  diagonally  between 
two  adjacent  enemy  units,  without  entering  the  neighborhood  of  either.  If 
this  problem  is  eliminated  in  a  square  grid  by  disallowing  diagonal  move¬ 
ment,  then  it  restricts  movement  direction  choice  to  only  four  directions, 
requiring  units  to  move  up  to  45°  off  of  their  desired  direction,  with  a 
loss  of  29%  of  their  effective  speed.  In  a  hexagonal  grid  the  correspond¬ 
ing  maximum  loss  is  13%.  A  hexagonal  grid  also  eliminates  complications 
from  the  two  types  of  adjacencies  when  evaluating  a  situation,  choosing 
movement  direction,  and  calculating  speed  and  arrival  time  at  the  next 
location.  Another  benefit  is  that  a  locus  of  points  at  a  given  count  of 
hexes  away  from  a  center  hex  more  closely  approximates  a  circle  than  a 
similar  locus  on  a  square  grid.  This  allows  distance  considerations,  such 


as  the  range  o*  artillery,  to  be  expressed  as  a  given  number  of  hexes. 

i 

With  a  square  grid  such  a  procedure  would  introduce  unacceptable  errors. 

One  ultimate  goal  in  a  modeling  system,  of  which  I  COR  is  but  one 
member,  is  the  provision  for  scale  change  of  the  system  to  different  levels 
of  detail.  It  is  possible  with  a  hexagonal  grid  to  divide  each  neighbor¬ 
hood  into  seven  smaller  neighborhoods  which,  when  this  is  done  for  all 
hexes,  creates  a  new -hexagonal  grid  of  smaller  hexes.  Conversely,  groups 
of  seven  hexes  can  be  grouped  together  to  form  larger  hexes.  Figure  B-1 
illustrates.  For  each  level  of  aggregation,  the  size  (diameter)  of  the 
next  larger  hex  is  times  that  of  the  smaller  hexes.  The  axis  of 
straight  rows,  or  the  "grain"  of  the  hex  field,  rotates  approximately  19° 
counterclockwise.  In  the  BOM  hexagonal  system,  levels  of  hexes  are  defined 
as  shown  in  Figure  B-2.  The  size  hex  used  for  the  units  in  ICOR  is  level 
4,  or  3.57  Km  diameter  (and  center  to  center). 

A  numbering  scheme  for  hexes  must  define  the  level  of  the  hex,  and  its 
position  in  the  plane  of  hexes  at  that  level.  In  the  BDM  hex  numbering 
system,  the  level  of  the  hex  is  equal  to  12  minus  the  number  of  digits  in 
the  hex  address.  Thus,  a  single  digit  hex  address  is  a  level  11  hex  of 
3,241  Km  diameter.  A  two  digit  hex  adds  resolution  of  an  additional  level, 
to  1225  km.  In  ICOR,  the  8  digit  hex  numbers,  or  addresses,  give  8  levels 
of  resolution,  which  corresponds  to  level  4,  or  3.57  km  hexes. 

As  a  hex  address  is  read  from  left  to  right  one  reads  from  most  signi¬ 
ficant  to  least  significant  digit.  At  each  digit,  one  can  consider  a 
selection  of  a  smaller  hex  within  the  larger,  or  higher  level,  hex  given  by 
the  preceeding  digits.  Figure  B-3  illustrates  this  disaggregation. 

At  each  level,  a  single  digit  represents  the  seven  possible  smaller 
hexes,  and  corresponding  directions.  These  directions  are  shown  in 
Figure  B-4.  If  the  digit  is  considered  to  be  an  octal  number  of  three 
bits,  each  bit  equal  to  one  indicates  a  one  hex  diameter  vector  in  the  i, 
j,  or  k  directions.  Thus  the  vectors  in  each  of  the  three  basic  directions 
are  001  or  1  for  i,  010  or  2  for  j,  and  100  or  4  for  k.  Other  directions 
are  represented  by  combinations.  The  combination  111  or  7  is  used  for  the 
null  vector  rather  than  0. 
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LEVEL 

HEX  DIAMETER 

HEX  AREA 

0 

72.9  M 

4601  M2 

1 

192.8  M 

32205  M2 

2 

510.2  M 

225434  M2 

3 

1.35  KM 

1578035  M2 

4 

3.57  KM 

11.0  KM2 

5 

9  45  KM 

77  3  KM2 

6 

25  00  KM 

541  3  KM2 

7 

66.14  KM 

3788  9  KM2 

8 

175.00  KM 

26522  KM2 

9 

463.01  KM 

185654  KM2 

10 

1225.00  KM 

1299579  KM2 

11 

3241.05  KM 

9097056  KM2 

12 

8575  00  KM 

63679389  KM2 

Figure  C-4 


Hex  Dimensions 


As  a  practical  matter,  a  hex  grid  having  hex  addresses  on  it  for 
cluster-center  hexes  but  not  others  is  usually  used  in  the  play  of  the  ICOR 
simulation.  There  are  two  cases: 

(1)  In  computer  generated  hex  maps,  the  number  given  in  the  center 
hex  is  that  of  the  higher  level  hex  at  the  next  level.  To  get  the  actual 
hex  number,  append  7  to  the  hex  address  of  the  center  hex  (in  which  the 
number  is  given).  For  each  adjacent  hex  append  the  number  for  the  given 
hex  direction  of  that  hex  relative  to  the  center  hex  (as  shown  in 
Figure  B-5  for  level  4). 

(2)  In  some  other  manually-generated  maps,  the  hex  address  of  the 
center  hex  at  the  level  of  the  hexes  shown  is  given.  This  results  in  all 
hex  addresses  for  center  hexes  ending  in  the  digit  7.  If  this  is  the  case, 
the  hex  address  of  each  adjacent  hex  may  be  found  by  deleting  the  last  7 
and  appending  the  hex  direction  from  the  center  hex  to  that  hex. 

The  hex  coordinate  system  used  in  the  ICOR  model  is  centered  near  the 

town  of  Fulda.  The  hex  7,  and  all  hexes  7 - 7,  are  centered  at  50°30'N, 

9°30'E  or  NA3594  in  UTM.  If  one  starts  with  a  blank  (no  addresses)  hex 
sheet,  the  origin  would  then  be  labeled  with  the  number  7.... 7  with  the 
number  of  7's  indicating  the  level  of  hexes.  Figure  B-6  illustrates  how 
all  other  hexes  on  the  sheet  can  then  be  numbered.  Summarizing,  to  plot  a 
center  hex  at  the  given  level,  count  hexes  as  follows: 


Level 

Hexes  in  Given  Hex  Oi recti on 

and  Hexes  to  Left 

Same 

1 

0 

1  higher 

2 

1 

2  higher 

3 

5 

3  higher 

1 

18 

77777147 
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ATTN:  Technical  Library  ATAA-SL 
White  Sands  Missile  Range,  NM  88002 
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